12:46 PM 25-FEB-99 Y2K BUG FIXES, AMCH 6.8 Patch 3. Restore 8 routines. AMCHPOST AMCHPOST ;IHS/ANMC/MWR - POST-INIT CONTROL; [ 05/16/96 3:05 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**1**;APR 30, 1996 ; ;---> PATCH TO UPDATE IMMS DUE TABLE ;MWR D MONTH ;---> END PATCH ;MWR Q EN D ^AMCHMMS,^AMCHVPI MMR W !!,"The 'MMR' vaccine is now considered a 'series' vaccine.",!,"Series vaccines are handled somewhat differently by the",!,"Vaccine Accountability Report and some of the",!,"'due for immunizations' reports. In order to work properly," W !,"the series number for each 'series' vaccine must be indicated",!,"for each dose received by each child. Most 'MMR' vaccines",!,"were entered without indicating the series. This utility" W !,"will automatically add a series '1' to each 'MMR' for",!,"every child IF no series has already been indicated.",!,"It will NOT change any data if a series number has already",!,"been indicated for the 'MMR'." S DIR(0)="YO",DIR("A")="Proceed with MMR series update",DIR("B")="NO" W ! D ^DIR K DIR I Y'=1 W !!,"No MMR series update has occured." Q S AMCHV=$O(^AUTTIMM("D","MMR",0)) I 'AMCHV W !!,"I could not find MMR in the IMMUNIZATION file.",!,"No MMR series update has occured." Q I $P(^AUTTIMM(AMCHV,0),U,3)'=17 W !!,"I could not find a valid MMR in the IMMUNIZATION file.",!,"No MMR series update has occured." Q W ! D WAIT^DICD W ! S AMCH=0 F S AMCH=$O(^AUPNVIMM(AMCH)) Q:'AMCH I $D(^(AMCH,0)),$P(^(0),U)=AMCHV,$P(^(0),U,4)="" S $P(^(0),U,4)=1 W !,"MMR series update has completed successfully." Q ; ; MONTH ;EP;TO SET MONTH AT WHICH MMR, HIB AND DPT ARE DUE. ;MWR D ^XBKVAR ;---> NEW VARIABLES ;MWR N AMCHMMR,AMCHHIB,AMCHDPT,DIR ; ;---> CHOOSE MMR SERIES 1 DUE AT 12 OR 15 MONTHS ;MWR W !!?5,"The current MMR setting is: " W $S($D(^AMCH(83,7,"G",1,"V",3,0)):12,1:15)," MONTHS" S DIR(0)="SO^1:MMR due at 12 Months;2:MMR due at 15 Months" S DIR("A")=" Which one" D ^DIR S AMCHMMR=$S("12"[+Y:+Y,1:"") I AMCHMMR=1 D .S ^AMCH(83,7,"G",1,"V",3,0)="3^1" .S ^AMCH(83,7,"G",1,"V","B",3,3)="" I AMCHMMR=2 D .K ^AMCH(83,7,"G",1,"V",3,0) .K ^AMCH(83,7,"G",1,"V","B",3,3) ; ; ;---> CHOOSE HIB (ONLY ONE SERIES) DUE AT 12 OR 15 MONTHS ;MWR W !!!?5,"The current HIB setting is: " W $S(+^AMCH(83,7,"G",1,"V",4,0)=7:12,1:15)," MONTHS" S DIR(0)="SO^1:Last HIB due at 12 Months;2:Last HIB due at 15 Months" S DIR("A")=" Which one" D ^DIR S AMCHHIB=$S("12"[+Y:+Y,1:"") I AMCHHIB=1 D .S ^AMCH(83,7,"G",1,"V",4,0)="7^1" .S ^AMCH(83,7,"G",1,"V","B",7,4)="" .K ^AMCH(83,7,"G",1,"V","B",4,4) .K ^AMCH(83,7,"G",1,"V",5,0) .K ^AMCH(83,7,"G",1,"V","B",5,5) I AMCHHIB=2 D .S ^AMCH(83,7,"G",1,"V",4,0)="4^3" .S ^AMCH(83,7,"G",1,"V","B",4,4)="" .S ^AMCH(83,7,"G",1,"V",5,0)="5^3" .S ^AMCH(83,7,"G",1,"V","B",5,5)="" .K ^AMCH(83,7,"G",1,"V","B",7) ; ; ;---> CHOOSE DPT SERIES 4 DUE AT 12 OR 15 MONTHS ;MWR W !!!?5,"The current DPT setting is: " W $S($P(^AMCH(83,7,"G",1,"V",1,0),U,2)=4:12,1:15)," MONTHS" S DIR(0)="SO^1:DPT series 4 due at 12 Months" S DIR(0)=DIR(0)_";2:DPT series 4 due at 15 Months" S DIR("A")=" Which one" D ^DIR S AMCHDPT=$S("12"[+Y:+Y,1:"") I AMCHDPT=1 D .S ^AMCH(83,7,"G",1,"V",1,0)="1^4" .S ^AMCH(83,7,"G",1,"V","B",1,1)="" .S ^AMCH(83,3,"G",1,"V",1,0)="1^4" .S ^AMCH(83,3,"G",1,"V","B",1,1)="" I AMCHDPT=2 D .S ^AMCH(83,7,"G",1,"V",1,0)="1^3" .S ^AMCH(83,7,"G",1,"V","B",1,1)="" .S ^AMCH(83,3,"G",1,"V",1,0)="1^4" .S ^AMCH(83,3,"G",1,"V","B",1,1)="" ; HEP ; ;---> ADD HEP-B AS DUE FROM AGES 1-5 W !!!?5,"Do you wish to make HEP-B due for ages 1-5 years?" S DIR(0)="Y",DIR("A")=" Enter Yes or No" D ^DIR W ! I $D(DIRUT) Q D @$S(Y:"SETHEP",1:"KILLHEP") W !!?5,"Settings complete." N DIR,DIRUT,X,Y S DIR(0)="E" W ! D ^DIR W ! Q ; SETHEP ;EP ;---> MAKE HEP-B DUE FOR AGES 1-5 YEARS. S ^AMCH(83,7,"G",1,"V",9,0)="9^3" S ^AMCH(83,7,"G",1,"V","B",9,9)="" S ^AMCH(83,3,"G",1,"V",9,0)="9^3" S ^AMCH(83,3,"G",1,"V","B",9,9)="" S ^AMCH(83,2,"G",1,"V",9,0)="9^3" S ^AMCH(83,2,"G",1,"V","B",9,9)="" S ^AMCH(83,1,"G",1,"V",9,0)="9^3" S ^AMCH(83,1,"G",1,"V","B",9,9)="" S ^AMCH(83,8,"G",1,"V",9,0)="9^3" S ^AMCH(83,8,"G",1,"V","B",9,9)="" Q ; KILLHEP ;EP ;---> MAKE HEP-B NOT DUE FOR AGES 1-5 YEARS. K ^AMCH(83,7,"G",1,"V",9,0) K ^AMCH(83,7,"G",1,"V","B",9,9) K ^AMCH(83,3,"G",1,"V",9,0) K ^AMCH(83,3,"G",1,"V","B",9,9) K ^AMCH(83,2,"G",1,"V",9,0) K ^AMCH(83,2,"G",1,"V","B",9,9) K ^AMCH(83,1,"G",1,"V",9,0) K ^AMCH(83,1,"G",1,"V","B",9,9) K ^AMCH(83,8,"G",1,"V",9,0) K ^AMCH(83,8,"G",1,"V","B",9,9) Q AMCHQDP1 AMCHQDP1 ;IHS-OIRM/DSD-ANMC/THL - PRINT DUE/DELINQUENT LISTS; [ 02/25/1999 11:49 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**2,3**;JAN 19, 1999 D SB2^AMCHALG G END:$O(AMCH("NEEDS",""))="" B2 S (AMCH("C"),AMCH("I"))=0 F S AMCH("I")=$O(AMCH("NEEDS",AMCH("I"))) Q:AMCH("I")<1 S AMCH("C")=AMCH("C")+1 I $Y+AMCH("C")+3>AMCHSL D:$D(AMCHQTC)&(IOST["C-") CON^AMCHUPRT G END:$D(DUOUT) D HEAD^AMCHUPRT D HP I $D(AMCHADDR)!$D(AMCHADR2) D SUBADD W ! W !,?4,"Needs " B21 ;EP;TO DISPLAY IMMUNIZATIONS NEEDED S AMCHCON=1,AMCH("G")=0 F S AMCH("G")=$O(AMCH("NEEDS",AMCH("G"))) Q:AMCH("G")<1 S X=AMCH("NEEDS",AMCH("G")) D SBW END Q HP I $D(AMCH("DFN")),$D(^DPT(AMCH("DFN"),0)) S X=^(0),AMCH("N")=$P(X,U,1),AMCH("SERIES")=$P(X,U,2) W !,$E($P(AMCH("N"),",",1)_", "_$P(AMCH("N"),",",2,99),1,20) S:'$D(AMCHSITE) AMCHSITE=$P(AMCHPAR,U,1) I $D(^AUPNPAT(AMCH("DFN"),41,AMCHSITE,0)) W " (",$P(^(0),U,2),")" S AMCH("N")=$P(X,U,3) G H2:'AMCH("N") W ?21," " W:$E(AMCH("N"),4,5) $E(AMCH("N"),4,5) W:$E(AMCH("N"),6,7) "-",$E(AMCH("N"),6,7) W "-",$E(AMCH("N"),2,3) S X1=DT,X2=AMCH("N") D ^%DTC S AMCHDAYS=X S AMCH("N")=$S(X<60:X_" Days",X<1096:$J(X/30.44,0,0)_" Months",1:$J(X/365.25,0,0)_" Years") W " (",AMCH("N"),")" H2 S X="" I $D(^AMCH(85,AMCH("DFN"),1)),$P(^(1),U,2)]"" S X=$P(^(1),U,2) G H3 I $D(^DPT(AMCH("DFN"),.24)),$P(^(.24),U,3)]"" S X=$P(^(.24),U,3) H3 W:X]"" ?52,"Parent: ",$E(X,1,19) Q SBW S AMCH("D")="",X=$P(AMCH("NEEDS",AMCH("G")),U,3) I X D DAT S AMCH("D")=Y S AMCH("SERIES")=$P(AMCH("NEEDS",AMCH("G")),U,2),AMCH("VACCINE")=$P(AMCH("NEEDS",AMCH("G")),U,4) I 'AMCH("VACCINE") S AMCH("CODE")=$O(^AMCH(82,AMCH("G"),"I",0)) D .I AMCH("CODE"),$D(^AMCH(82,AMCH("G"),"I",AMCH("CODE"),0)) S AMCH("CODE")=$P(^(0),U,1) D ..I "^37^38^39^"[(U_AMCH("CODE")_U),$D(AMCHDHIB),AMCHDHIB]"" S AMCH("V")=AMCHDHIB ..I AMCH("CODE")]"" S AMCH("VACCINE")=$O(^AUTTIMM("C",AMCH("CODE"),"")) D:AMCH("VACCINE") XCONTRA^AMCHUCAL I AMCH("VACCINE"),$D(^AUTTIMM(AMCH("VACCINE"),0)) S AMCH("VNAME")=$P(^(0),U,2),AMCH("MAX")=$P(^(0),U,5) I AMCHDAYS>$S($D(^AMCH(83,7,"G",1,"V",5,0)):426,1:350),AMCH("VNAME")["HIB"!(AMCH("VNAME")["Hib") S AMCH("VNAME")="HIB" W ?10,AMCH("VNAME") I AMCH("MAX")>1,AMCH("VNAME")'="HIB" W " ",AMCH("SERIES")+1 I AMCHPGM'["AMCHQDP1" W ! Q I AMCH("SERIES") D .W ?22,": " .W:$P(AMCH("NEEDS",AMCH("G")),U,5)]"" "** BUT NOT UNTIL AFTER ",$P(AMCH("NEEDS",AMCH("G")),U,5)," ** ",!?22,": " .W AMCH("VNAME")," ",AMCH("SERIES")," Received ",$S($L(AMCH("D"))>5:"on",1:"in")," ",AMCH("D") I $D(AMCHCI) K AMCHCI W !,?8,"NOTE: ",AMCH("V")," IS CONTRAINDICATED FOR THIS PATIENT." I AMCH("MAX")>1,'AMCH("SERIES"),AMCH("VNAME")'="HIB" W ?22,": ","No prior Immunization in this series on record." W ! Q DAT ;S AMCH("M")=+$E(X,4,5),Y=$E(X,2,3),X=$E(X,6,7) ;S:'AMCH("M") AMCH("M")="" S:'X X="" ;S Y=AMCH("M")_$S(AMCH("M"):"-",1:"")_X_$S(X:"-",1:"")_Y ;I 'X,'AMCH("M") S Y=Y+1900 ;Beginning Y2K fix ; Set Y = to the the first three digits of the FileMan internal date in ; X and in turn referenced the 2nd and 3rd digits of Y. Then in the ; next line if 'X and 'AMCH("M") then I reset Y=Y+1700 -- in compliance ; with the Y2k solution set. S AMCH("M")=+$E(X,4,5),Y=$E(X,1,3),X=$E(X,6,7) S:'AMCH("M") AMCH("M")="" S:'X X="" ;Y2000 S:X!AMCH("M") Y=AMCH("M")_$S(AMCH("M"):"-",1:"")_X_$S(X:"-",1:"")_$E(Y,2,3) I 'X,'AMCH("M") S Y=Y+1700 ;Y2000 ;Ending Y2k fix block Q SUBADD ;EP I $D(AMCHADDR),'$D(^DPT(AMCH("DFN"),.11)) W !?5,"NO ADDRESS ON FILE" G SUBADD1 I $D(AMCHADDR) D .S AMCHST=$P(^DPT(AMCH("DFN"),.11),U,5),AMCHSTAT=$S(AMCHST:$P(^DIC(5,AMCHST,0),U,2),1:"") W !?9,"ADDRESS : ",$P(^DPT(AMCH("DFN"),.11),U,1),"; ",$P(^(.11),U,4),", ",AMCHSTAT," ",$P(^(.11),U,6) .I $D(^DPT(AMCH("DFN"),.13)) W !?9,"PHONE: ",$P(^(.13),U) SUBADD1 I $D(AMCHADR2),$D(^AUPNPAT(AMCH("DFN"),12,0)),$P(^(0),U,3) S D0=AMCH("DFN") W !,"LOCATION: " D ^AMCHLOH K AMCHST,AMCHSTAT Q AMCHQFS AMCHQFS ;IHS-OIRM/DSD-ANMC/THL - FLU DUE/DELINQUENT LIST CONTROLLER; [ 02/25/1999 11:49 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**2,3**;FEB 08, 1999 Z G END:'$D(AMCHTSK) S AMCH("N")=0 F AMCH("I")=1:1 S AMCH("N")=$O(^TMP("AMCH",$J,AMCHTSK,AMCH("N"))) Q:AMCH("N")="" I $D(^(AMCH("N")))#2 S @AMCH("N")=^(AMCH("N")) I '$D(AMCHPAR) S AMCHPAR=$S($D(^AMCH(81,1,0)):^(0),1:"") S (AMCHASUM,AMCH("DFN"))=0 D SETUP A1 S AMCH("DFN")=$O(^AMCH(85,"AA","A",AMCH("DFN"))) G A9:AMCH("DFN")="" D SB1 S AMCHASUM=AMCHASUM+1 I $D(AMCHLFML) S ^TMP("AMCH",$J,AMCHTSK,"S",AMCH("DFN"))=AMCHLF G A1 I AMCHLF]"" S ^TMP("AMCH",$J,AMCHTSK,"S",AMCH("DFN"))=AMCHLF G A1 A9 K AMCHT G END:$D(AMCHLETT) D ^AMCHUSRN S:AMCHASUM ^TMP("AMCH",$J,AMCHTSK,"S","SUM")=AMCHASUM K AMCHASUM S AMCHPGM="^AMCHQFP" G ^AMCHUPRT END Q XSB1 ;EP D SETUP G SB1 SETUP S X=DT D DTBS S AMCHQFSD=Y,AMCHVN=$O(^AUTTIMM("C",12,0)) Q SB1 S X=$O(^AUPNVIMM("AA",AMCH("DFN"),AMCHVN,0)),AMCHLF="" I X="" S AMCHLF=0 G S19 S X=9999999-$P(X,".",1) D DTBS S Y=AMCHQFSD-Y I $D(AMCHLFML) S AMCHLF=X G S19 I Y>182 S AMCHLF=X S19 I 'AMCHLF,$P(^AMCH(85,AMCH("DFN"),2),U,2)=1 S AMCHLF="Refused" Q DTBS S AMCH("M")=+$E(X,4,5),AMCH("D")=+$E(X,6,7),Y=$E(X,1,3)+1700 I AMCH("M")<1!(AMCH("M")>12)!(AMCH("D")<1)!(AMCH("D")>31)!(Y<1841) S Y="" G DTBSK ;STARTING Y2K BUG FIX 2/8/9 MJL IHS TUCSON ;S AMCH("L")=0 I Y#4=0,'(Y=1900) S AMCH("L")=1 ;I AMCH("D")>30,AMCH("M")=4!(AMCH("M")=6)!(AMCH("M")=9)!(AMCH("M")=11) S Y="" G DTBSK ;I AMCH("M")=2,AMCH("L")=0*(AMCH("D")>28)!(AMCH("L")=1*(AMCH("D")>29)) S Y="" G DTBSK ;I AMCH("L")=0 S AMCH("J")=$P("0,31,59,90,120,151,181,212,243,273,304,334",",",AMCH("M"))+AMCH("D") ;E S AMCH("J")=$P("0,31,60,91,121,152,182,213,244,274,305,335",",",AMCH("M"))+AMCH("D") ;S Y=AMCH("J")+(Y-1841*365)+(Y-1841\4)-(Y>1900*1) S AMCH("L")=0 I Y#4=0 S AMCH("L")=1 I Y#100=0,Y#400>0 S AMCH("L")=0 I AMCH("D")>$S("^1^3^5^7^8^10^12^"[("^"_AMCH("M")_"^"):31,AMCH("M")=2:(28+AMCH("L")),1:30) S Y="" G DTBSK S AMCH("J")=$P("0,31,59,90,120,151,181,212,243,273,304,334",",",AMCH("M"))+AMCH("D") I AMCH("M")>2 S AMCH("J")=AMCH("J")+AMCH("L") ; HORLOG CALCULATION S Y=Y-1,Y=AMCH("J")+(Y-1840*365)+(Y\4)-(Y\100)+(Y\400)-446 ;ENDING Y2K BUG FIX DTBSK K AMCH("D"),AMCH("J"),AMCH("L"),AMCH("M") Q AMCHQL AMCHQL ;IHS/ANMC/MWR - QUEUE IMM. DUE LETTERS; [ 05/13/96 8:49 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**1**;MAR 01, 1995 Z K AMCHDT S AMCHRPT="Due Letters" A0 S AMCHOFFS=0,AMCHO=1,AMCHPT=0 D HEAD K AMCHTSK A01 S:'$D(AMCHDT) AMCHDT=DT D ^AMCHQUD G END:$D(DTOUT)!$D(DUOUT) I '$D(AMCHDT) W *7," You must enter a date!",!!,?5,"Enter a '^' to return to the report menu.",! G A01 A1 W ! S DIR(0)="YO",DIR("A")="Do you want to print letters for individual patients",DIR("B")="NO" D ^DIR K DIR ; ;---> PATCH TO SAVE WHETHER PRINTING INDIVIDUALS OR BATCH. ;MWR ;---> IF BATCH, DO NOT PRINT LETTERS WHERE MINIMUM INTERVAL HAS ;MWR ;---> NOT BEEN REACHED FOR ALL IMMS. S AMCH("INDIV")=$S(Y=1:1,1:0) ;---> END PATCH ;MWR ; G END:$D(DTOUT)!$D(DUOUT),C1:'Y D ^AMCHUTAB S AMCHMXA=$P(AMCHPAR,U,7)*30.44,AMCHORD=0 A2 K AMCH("DFN") D ^AMCHUPT G END:$D(DTOUT)!$D(DUOUT),A9:'$D(AMCH("DFN")) I '$D(^AMCH(85,AMCH("DFN"),1)) W !!,"This patient is NOT on the immunization register." G A2 I $P(^AMCH(85,AMCH("DFN"),1),U,1)'="A" W !!,"This patient's Immunization Register status is INACTIVE." G A2 S AMCHINDV="",AMCH("DUE")="" D XA1^AMCHUSRH G:AMCH("DUE")]"" A5 W *7,! A3 W !!,"This patient is NOT DUE for any immunizations, but do you want to print" S DIR(0)="YO",DIR("A")="a WELL CHILD appointment letter",DIR("B")="NO" D ^DIR K DIR G END:$D(DTOUT),A2:$D(DUOUT)!'Y A5 D TSK^AMCHU:'$D(AMCHTSK) S AMCHORD=AMCHORD+1,^TMP("AMCHPT",AMCHTSK,AMCHORD,AMCH("DFN"))=AMCH("DUE") W !?10," Recorded" G A2 A9 K AMCHT S AMCHPT=1 G END:'$D(AMCHTSK),C1 C1 S AMCHPO="" C2 W ! S DIR(0)="YO",DIR("A")="Do you want to print the Clinic Location on the letters",DIR("B")="YES" D ^DIR K DIR G END:$D(DTOUT),A0:$D(DUOUT),C4:'Y S AMCHPO=$P(AMCHPAR,U,3) C3 W ! S DIR(0)="FO^1:30",DIR("A")="Location Name" S:$P(AMCHPO,U,1)]"" DIR("B")=$P(AMCHPO,U,1),DIR("?")="Enter the location name to be printed on the letters." D ^DIR K DIR G END:$D(DTOUT),C1:$D(DUOUT) G C4:Y="" I Y?1A.ANP,$L(Y)<40,$L(Y)>3 S $P(AMCHPO,U,1)=Y G C4 W *7," ??" G C3 C4 W ! S DIR(0)="YO",DIR("A")="Do you want to print the above date as the clinic date",DIR("B")="YES" D ^DIR K DIR G END:$D(DTOUT),C3:$D(DUOUT) S $P(AMCHPO,U,2)=$P(AMCHDT,U,Y) C6 W ! S DIR(0)="YO",DIR("A")="Ask the parents to call for an appointment for their child",DIR("B")="NO",AMCHLTR="",DIR("?",1)="Enter YES only if you want the letter to ask the parents",DIR("?")="to call you to set up an appointment time." D ^DIR K DIR G END:$D(DTOUT),C6:$D(DUOUT) S:Y AMCHLTR=1 C9 K AMCHPGM S AMCHPGM="^AMCHQLS" F AMCH("I")="AMCHOFFS","AMCHPT","AMCHPO","AMCHLTR" S AMCHPGM(AMCH("I"))=@AMCH("I") G ^AMCHQ:AMCHPT W !!,"How would you like the letters to be sorted ? " G XA1^AMCHUQ END K AMCHTSK,AMCHT Q HEAD W:$D(IOF) @IOF D:'$D(AMCHPAR) ^AMCHU W !,?80-$L($P(AMCHPAR,U,3))\2,$P(AMCHPAR,U,3),! W !,?28,"Immunization Due Letters",! Q AMCHQLP1 AMCHQLP1 ;IHS/ANMC/MWR - PRINT DUE LETTERS; [ 05/13/96 8:50 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**1**;APR 30, 1996 ;;PRINT DUE LETTERS I AMCH("DUE")="",$D(AMCHORD) G A0 D SB2^AMCHALG ; ;---> BEGIN PATCH TO CANCEL THIS LETTER IF NO IMMS DUE, UNLESS ;MWR ;---> THIS IS AN INDIVIDUALLY PRINTED LETTER FOR WELL CHILD. ;MWR D MWRFIX Q:('$D(AMCH("NEEDS"))&('$G(AMCH("INDIV")))) ;---> END PATCH ;MWR ; Q:AMCH("DUE")="" A0 K AMCH("A") D A1 B1 D HEAD S AMCH("G")=$S($D(^AMCH(85,AMCH("DFN"),1)):$P(^(1),U,2),1:"") S:AMCH("G")="" AMCH("G")="Parent" W !!!,?5,"Dear Parent,",! I $D(^DPT(AMCH("DFN"),0)) S AMCH("G")=$P(^(0),U,1),AMCH("L")=$P(AMCH("G"),",",1),AMCH("G")=$P(AMCH("G"),",",2,99) S:$E(AMCH("G"),1)=" " AMCH("G")=$E(AMCH("G"),2,99) S AMCH("G")=$P(AMCH("G")," ",1)_" "_AMCH("L") E S AMCH("G")="" W !,?5,"Your child" W:AMCH("G")]"" " ",AMCH("G") W " is due for WELL CHILD CARE or",!,?5,"IMMUNIZATIONS. According to our records the following",!,?5,"immunizations have already been received:",!! S AMCH("D")="" I '$D(AMCH("A")) W !,?10,"NO Immunizations on our records!" B2 S AMCH("D")=$O(AMCH("A",AMCH("D"))) I AMCH("D")]"" D SBW G B2 W !!,?5,$S(AMCH("G")="":"Your child",1:$P(AMCH("G")," ",1))," is now due for " I AMCH("DUE")="" W "WELL CHILD CARE.",!! G B3 ; ;---> PATCH TO PRINT "WELL CHILD CARE" FOR INDIVIDUAL LETTERS, ;MWR ;---> EVEN IF NOT IMMS DUE. I '$D(AMCH("NEEDS"))&($G(AMCH("INDIV"))) W "WELL CHILD CARE.",!! G B3 ;---> END PATCH. ;MWR ; W "the immunizations indicated below:",!! D SB2^AMCHALG ; ;---> PATCH TO ELIMINATE IMMS WITHOUT MINIMUM INTERVAL. ;MWR D MWRFIX ;---> END PATCH. ;MWR ; D B21^AMCHQDP1 W ! I $D(IOST),$E(IOST,1,2)="P-"!($E(IOST,1,2)="S-") S DA=AMCH("DFN"),DR="104.5////"_DT,DIE="^AMCH(85," D ^DIE K DIE,DR,DA B3 I $E($G(IOST),1,2)="C-" D SBRS^AMCHU W !,?5,"If you feel our records are not correct, notify us so we",!,?5,"may make the corrections to update our records. Otherwise," G:AMCHLTR=1 B6 W !,?5,"please bring your child to the clinic at the time and location",!,?5,"given below:" G B7 B6 W !,?5,"please call for an appointment for your child. You may use the",!?5,"spaces below to note the time and date of the appointment." B7 W !!,?6,AMCHDTA,?45,AMCHPO,!,?5,"-------------",?25,"---------------",?45,"-------------------" W !,?10,"Date",?30,"Time",?50,"Location" D TAIL I AMCHADDP D ^AMCHQLP3 END Q HEAD W:$D(IOF) @IOF W !!,?79-$L($P(AMCHLOCA,U,1))\2,$P(AMCHLOCA,U,1) F AMCH("I")=7:1:10 S X=$P(AMCHADDP,U,AMCH("I")) W ! I X]"" W ?79-$L(X)/2,X W !,?60 D ^%D Q TAIL W !! F AMCH("I")=3,4 W !,?5,"PHONE #: ",$P(AMCHADDP,U,AMCH("I")),?45,$P(AMCHADDP,U,AMCH("I")+2) I $D(^AUPNPAT(AMCH("DFN"),41,DUZ(2),0)) W !!,?5,"IHS CHART #: ",$P(^(0),U,2) Q SBW W ! I AMCH("D") S X=AMCH("D") D DAT W ?10,$J(Y,12),": " S (AMCH("C"),AMCH("N"))=0 SBW1 S AMCH("C")=$O(AMCH("A",AMCH("D"),AMCH("C"))) Q:AMCH("C")="" W:AMCH("N") ", " S AMCH("N")=AMCH("N")+1,AMCH("V")=$P(AMCH("A",AMCH("D"),AMCH("C")),U,1),AMCH("S")=$P(AMCH("A",AMCH("D"),AMCH("C")),U,2) I AMCH("V"),$D(^AUTTIMM(AMCH("V"),0)) S AMCH("V")=$P(^(0),U,2) W:AMCH("S") AMCH("S")," " W AMCH("V") G SBW1 Q DAT S AMCH("M")=+$E(X,4,5),Y=$E(X,1,3)+1700,X=+$E(X,6,7) S:'AMCH("M") AMCH("M")="" S:'X X="" I AMCH("M") S AMCH("M")=$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",AMCH("M")) S Y=AMCH("M")_$S(AMCH("M")]"":" ",1:"")_$S(X:$S(X<10:" ",1:"")_X,1:"")_$S(X:", ",1:"")_Y Q SB2 W ! F AMCH("I")=1:1:5 W ?AMCH("I")*8,AMCH("I")," DTP" S AMCH("S")=0 W !! F AMCH("I")=1:1:5 I AMCH("I")'=3 S AMCH("S")=AMCH("S")+1 W ?AMCH("I")*8,AMCH("S")," OPV" W !!,?26,"MMR",?34,"Hib" Q SB3 F AMCH("I")=1:1 S AMCH("S")=$P(AMCH("DUE"),";",AMCH("I")) Q:AMCH("S")="" I $D(^AUTTIMM(+AMCH("S"),0)) W !,?10,$P(^(0),U,2) Q A1 ;SET ARRAY OF IMMUNIZATIONS ALREADY RECEIVED N X,Y,Z,% S (X,Y)=0 F S Y=$O(^AUPNVIMM("AC",AMCH("DFN"),Y)) Q:Y<1 D:$D(^AUPNVIMM(Y,0)) .S %=^AUPNVIMM(Y,0),Z=$P(%,U,1) .Q:'Z .S AMCH("SERIES")=$P(%,U,4),AMCH("VISDA")=$P(%,U,3),AMCH("D")="" .I AMCH("VISDA"),$D(^AUPNVSIT(AMCH("VISDA"),0)) S AMCH("D")=+$P(^(0),".",1) .S X=X+1,AMCH("A",AMCH("D"),X)=Z_U_AMCH("SERIES") Q ; MWRFIX ;EP ;---> PATCH TO PREVENT PRINTING OF IMMS W/O MINIMUM INTERVAL. ;MWR N N S N=0 F S N=$O(AMCH("NEEDS",N)) Q:'N D .K:$P(AMCH("NEEDS",N),U,5)]"" AMCH("NEEDS",N) Q ;---> END OF PATCH CODE. ;MWR AMCHQLP2 AMCHQLP2 ;IHS-OIRM/DSD-ANMC/THL - PRINT DUE/DELINQUENT LISTS; [ 02/25/1999 11:49 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**2,3**;NOV 9, 1998 A0 K AMCH("B") F AMCH("I")=1:1 S X=$P(AMCHV,";",AMCH("I")) Q:X="" S AMCH("B",+X)=$P(X,U,2) S AMCHI=0 A1 S AMCHI=$O(^AUPNVIMM("AC",AMCH("DFN"),AMCHI)) G B1:AMCHI<1,A1:'$D(^AUPNVIMM(AMCHI,0)) S X=^(0),AMCH("V")=$P(X,U,1) G A1:'AMCH("V") G A1:'$D(^AUTTIMM(AMCH("V"),0)) S AMCH("C")=$P(^(0),U,3) G A1:AMCH("C")="" S AMCH("G")=$O(^AMCH(82,"AB",AMCH("C"),0)) G A1:AMCH("G")="",A1:'$D(AMCH("B",AMCH("G"))) S AMCH("S")=$P(X,U,4),AMCH("K")=$P(X,U,3),AMCH("D")="" I AMCH("K"),$D(^AUPNVSIT(AMCH("K"),0)) S AMCH("D")=+$P(^(0),".",1) I $P(AMCH("B",AMCH("G")),U,2)'>AMCH("S") S AMCH("B",AMCH("G"))=$P(AMCH("B",AMCH("G")),U,1)_U_AMCH("S")_U_AMCH("D")_U_AMCH("V") G A1 G A1 B1 S AMCH("G")="" F AMCHI=1:1 S AMCH("G")=$O(AMCH("B",AMCH("G"))) Q:AMCH("G")="" D SBC:AMCH("B",AMCH("G")) G END XB2 ;EP B2 S AMCH("C")=0 F AMCH("I")=0:0 S AMCH("I")=$O(AMCH("B",AMCH("I"))) Q:AMCH("I")<1 S AMCH("C")=AMCH("C")+1 W ! S AMCHCON=1,AMCH("G")=0 F S AMCH("G")=$O(AMCH("B",AMCH("G"))) Q:'AMCH("G") S X=AMCH("B",AMCH("G")) D SBW END Q SBC S AMCH("S")=$P(AMCH("B",AMCH("G")),U,2)+1 Q:'$D(^AMCH(82,AMCH("G"),"S",AMCH("S"),0)) S AMCH("S")=$P(^(0),U,2) S X2=$P(AMCH("B",AMCH("G")),U,3) Q:'$E(X2,4,5) S X1=DT D ^%DTC ;I X-AMCHOFFS1 " ",$S(AMCH("S")=""&($P(AMCH("B",AMCH("G")),U)):$P(AMCH("B",AMCH("G")),U),1:AMCH("S")+1) W:$P(AMCH("B",AMCH("G")),U,5)]"" " (BUT NOT UNTIL AFTER ",$P(AMCH("B",AMCH("G")),U,5),") " W ! Q DAT ;S AMCH("M")=+$E(X,4,5),Y=$E(X,2,3),X=$E(X,6,7) S:'AMCH("M") AMCH("M")="" S:'X X="" ;S Y=AMCH("M")_$S(AMCH("M"):"-",1:"")_X_$S(X:"-",1:"")_Y I 'X,'AMCH("M") S Y=Y+1900 ;Beginning Y2K fix ; Set Y = to the the first three digits of the FileMan internal date in ; X and in turn referenced the 2nd and 3rd digits of Y. Then in the ; next line if 'X and 'AMCH("M") then I reset Y=Y+1700 -- in compliance ; with the Y2k solution set. S AMCH("M")=+$E(X,4,5),Y=$E(X,1,3),X=$E(X,6,7) S:'AMCH("M") AMCH("M")="" S:'X X="" ;Y2000 S:X!AMCH("M") Y=AMCH("M")_$S(AMCH("M"):"-",1:"")_X_$S(X:"-",1:"")_$E(Y,2,3) I 'X,'AMCH("M") S Y=Y+1700 ;Y2000 ;Ending Y2k fix block Q AMCHQOP AMCHQOP ;IHS-OIRM/DSD-ANMC/THL - PRINT IMMUNIZATION RECORD; [ 02/25/1999 11:49 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**2,3**;NOV 05, 1998 A0 ;W:$D(IOF) @IOF I $P(^AMCH(81,1,0),U,16)="" W !,?22,"UNITED STATES PUBLIC HEALTH SERVICE" E W !,?80-$L($P(^AMCH(81,1,0),U,16))\2,$P(^(0),U,16) I '$D(AMCHPAR) S AMCHPAR=$S($D(^AMCH(81,1,0)):^(0),1:"") W !,?80-$L($P(AMCHPAR,U,3))\2,$P(AMCHPAR,U,3),!!,?26,"OFFICIAL IMMUNIZATION RECORD",!!!!,?5,"According to our medical records the individual named below has",!,?5,"received the following immunizations:",!! HP I $D(AMCH("DFN")),$D(^DPT(AMCH("DFN"),0)) S X=^(0),AMCH("N")=$P(X,U,1),AMCH("S")=$P(X,U,2) W !,?5,"Name: ",$P(AMCH("N"),",",1),", ",$P(AMCH("N"),",",2,99),! S AMCH("N")=$P(X,U,3) G A1:'AMCH("N") W !,?5,"DOB: ",$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",$E(AMCH("N"),4,5))," " W:$E(AMCH("N"),6,7) +$E(AMCH("N"),6,7)," " W $E(AMCH("N"),1,3)+1700 F AMCHGBL="^AUPNVIMM","^AUPNVSK" S AMCHIMM=$S(AMCHGBL["VIMM":"^AUTTIMM",1:"^AUTTSK") D A1 .W !!,?15,$S(AMCHGBL["VIMM":"Immunization",1:"SKIN TEST"),?45,"Date Received",!,?5,"----------------------------------",?45,"-------------" .K AMCH("A") S AMCH("I")="" A2 .S AMCH("I")=$O(@AMCHGBL@("AA",AMCH("DFN"),AMCH("I"))) .G B1:AMCH("I")="" .S AMCH("D")="" A3 .S AMCH("D")=$O(@AMCHGBL@("AA",AMCH("DFN"),AMCH("I"),AMCH("D"))) .G A2:AMCH("D")="" .S AMCH("N")="",X=9999999-$P(AMCH("D"),".",1) A4 .S AMCH("N")=$O(@AMCHGBL@("AA",AMCH("DFN"),AMCH("I"),AMCH("D"),AMCH("N"))) .G A3:AMCH("N")="",A4:'$D(@AMCHGBL@(AMCH("N"),0)) S AMCH("S")=$P(@AMCHGBL@(AMCH("N"),0),U,4),AMCH("A",X,AMCH("N"))=AMCH("I")_U_AMCH("S") .G A4 B1 .S AMCH("D")="" B2 .S AMCH("D")=$O(AMCH("A",AMCH("D"))) .Q:AMCH("D")="" .D DAT .S AMCH("I")="" B3 .S AMCH("I")=$O(AMCH("A",AMCH("D"),AMCH("I"))) .G B2:AMCH("I")="" .S AMCH("V")=+AMCH("A",AMCH("D"),AMCH("I")),AMCH("S")=$P(AMCH("A",AMCH("D"),AMCH("I")),U,2) .I AMCH("V"),$D(@AMCHIMM@(AMCH("V"),0)) W !,?5,$S(AMCH("S"):AMCH("S")_" ",1:" "),$P(@AMCHIMM@(AMCH("V"),0),U,1),?45,$J(X,12) .G B3 C1 K AMCH("A"),AMCHGBL,AMCHIMM W !!!,?5,"Please review the immunizations listed above. If this child",!?5,"has not had the immunizations listed, or has had additional",!?5,"immunizations not listed, please inform the medical records clerk," W !?5,"nurse or physician so this record can be updated.",!!!,?57,$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",$E(DT,4,5))," ",+$E(DT,6,7),", ",$E(DT,1,3)+1700 W !,?5,"----------------------------------------",?55,"---------------",!,?15,"(Physician or Nurse)",?60,"(Date)",!!!,?5,"----------------------------------------",!,?19,"(Facility)" I $D(IOST),$E(IOST,1,2)="C-" D SBRS^AMCHU I $D(IOST),IOST?1"P-".E W:$D(IOF) @IOF END Q DAT S X="" Q:AMCH("D")'?7N ;S AMCH("M")=+$E(AMCH("D"),4,5),Y=19_$E(AMCH("D"),2,3),X=$E(AMCH("D"),6,7),X=$S(AMCH("M"):$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",AMCH("M")),1:" ")_" "_X_", "_Y ; Beginning Y2K fix ; Changed the hard set of Y from 19 prepended to the 2nd and 3rd ; digits of the FileMan internal formated variable AMCH("D") to 1700 ; added to the 1st 3 digits of the variable. S AMCH("M")=+$E(AMCH("D"),4,5),Y=1700+$E(AMCH("D"),1,3),X=$E(AMCH("D"),6,7),X=$S(AMCH("M"):$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",AMCH("M")),1:" ")_" "_X_", "_Y ;Y2000 ;end Y2K fix block Q AMCHQQP1 AMCHQQP1 ;IHS/ANMC/MWR - PRINT QUARTERLY IMM REPORT; [ 05/13/96 8:50 AM ] ;;6.8;IMMUNIZATION TRACKING SYSTEM;**1**;APR 30, 1996 ;;PRINT QUARTERLY IMM REPORT; A0 F AMCH("G")=6:-1:1 D SBM,SB1 G END:$D(DUOUT) W !,"Totals" S (AMCH("A"),AMCH("B"),AMCH("C"))="" F AMCH("I")=1,2 S X="AMCH("""_$C(64+AMCH("I"))_""")" D .F AMCH("J")=1:1:6 D ..I $D(^TMP("AMCH",$J,AMCHTSK,"V",AMCH("J"),AMCH("I"))) S @X=@X+^(AMCH("I")) ; ;---> PATCH TO SHOW TOTAL APPROPRIATE FOR AGE. ;MWR ;---> REMOVE LEADING "+" FROM $J(AMCH("B")). ;W ?14,$J(AMCH("A"),4),?26,+$J(AMCH("B"),6),?34,"|" W ?14,$J(AMCH("A"),4),?26,$J(AMCH("B"),6),?34,"|" ;---> END PATCH. ;MWR ; S:AMCH("A")*AMCH("B") AMCH("C")=$J(AMCH("B")/AMCH("A"),0,3)*100 I AMCH("C")="",AMCH("A") S AMCH("C")=0 F AMCH("I")=3:1:20 D .S AMCH("N")=0 .F AMCH("G")=1:1:6 D ..S:$D(^TMP("AMCH",$J,AMCHTSK,"V",AMCH("G"),AMCH("I"))) AMCH("N")=AMCH("N")+^(AMCH("I")) ..I AMCH("G")=6 W ?35+(AMCH("I")-3*5),$J(AMCH("N"),4) I AMCH("C")]"" S AMCH("C")="("_AMCH("C")_"%)" W !,?27,$J(AMCH("C"),7),?34,"|" E1 I $D(IOST),IOST?1"P-".E W:$D(IOF) @IOF I AMCHTER D CON END K AMCHM I '$D(DUOUT),AMCHQOPT G ^AMCHQQP2 K AMCHQSCN,^TMP("AMCH",$J,AMCHTSK) Q SB1 W !,?6,AMCH("F"),?20,AMCH("L",1),?34,"|" S (AMCH("N"),AMCH("O"),AMCH("A"))="" I $D(^TMP("AMCH",$J,AMCHTSK,"V",AMCH("G"),1)) S AMCH("N")=^(1) S:'AMCH("N") AMCH("N")="" I $D(^TMP("AMCH",$J,AMCHTSK,"V",AMCH("G"),2)) S AMCH("O")=^(2) S:'AMCH("O") AMCH("O")="" S:AMCH("N")*AMCH("O") AMCH("A")=$J(AMCH("O")/AMCH("N"),0,3)*100 I AMCH("A")="",AMCH("N") S AMCH("A")=0 W !,?5-$L(AMCH("D"))\2+($L(AMCH("D"))<5),$S(AMCH("D")'["27":AMCH("D"),1:24),?14,$J(+AMCH("N"),4),?20,AMCH("L",2),?26,$J(+AMCH("O"),6),?34,"|" F AMCH("I")=3:1:20 I $D(^TMP("AMCH",$J,AMCHTSK,"V",AMCH("G"),AMCH("I"))),^(AMCH("I")) W ?35+(AMCH("I")-3*5),$J(^(AMCH("I")),4) W !,?6,AMCH("T"),?20,AMCH("L",3),?34,"|" W:$D(AMCH("L",4)) !?20,AMCH("L",4),?34,"|" W:$D(AMCH("L",5)) !?20,AMCH("L",5) W:$D(AMCH("L",6)) !?20,AMCH("L",6) I AMCH("A")]"" S AMCH("A")="("_AMCH("A")_"%)" W ?27,$J(AMCH("A"),7),?34,"|" W !,"---------------------------------------------------------------------------------------------------------------------------" I AMCHTER,$Y>20 D CON I '$D(DUOUT) D HEAD^AMCHQQP S19 Q SBM S AMCH("D")=$P("3-4^5-6^7-15^16-18^19-23^24-27",U,AMCH("G")),X=$P(AMCH("D"),"-",1) D SBMD S AMCH("T")=Y,X=$P(AMCH("D"),"-",2) D SBMD S AMCH("F")=Y,X=$P($T(IMM),";;",AMCH("G")+1) K AMCH("L") F AMCH("I")=1:1 S Y=$P(X,U,AMCH("I")) Q:Y="" S AMCH("L",AMCH("I"))=Y S:AMCH("I")=3 AMCH("L",3)=AMCH("L",2),AMCH("L",2)="" Q SBMD S AMCH("M")=AMCHM,Y=AMCHY F AMCH("I")=1:1:X S AMCH("M")=AMCH("M")-1 I AMCH("M")<1 S AMCH("M")=12,Y=Y-1 S Y=$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",AMCH("M"))_" "_Y Q CON W *7 D SBRS^AMCHU S AMCHCON=0 Q IMM ;;DTP-1^OPV-1^HIBT-1^PVHIB-1^HEPB-1;;DTP-2^OPV-2^HIBT-2^PVHIB-2^HEPB-2;;DTP-3^OPV-3^HIBT-3^PVHIB-2^HEPB-2;;DTP-3^OPV-3^MMR^HIB^HEPB-2;;DTP-4^OPV-3^MMR^HIB^HEPB-3;;DTP-4^OPV-3^MMR^HIB^HEPB-3