AGCHART ; IHS/ASDS/EFG - LIST OF REGISTERED PATIENTS BY CHART NUMBER ;
;;7.1;PATIENT REGISTRATION;**4,5**;AUG 25,2005
C W !!,"START WITH WHAT CHART NUMBER? Print All Charts// " D READ^AG G K:$D(DTOUT)!$D(DUOUT)!$D(DFOUT),QUES:$D(DQOUT) I $D(DLOUT) S AGBEG=0,AGEND=999999999 G E
G QUES:+Y<1 S AGBEG=+Y
D W !!,"END WITH WHAT CHART NUMBER? Last One// " D READ^AG G K:$D(DTOUT)!$D(DFOUT),C:$D(DUOUT),QUES:$D(DQOUT) I $D(DLOUT) S AGEND=999999999 G E
I +Y<AGBEG W !!,*7,"THE ENDING NUMBER IS LESS THAN THE BEGINNING NUMBER." G C
S AGEND=+Y
E S AGIO=IO,AG("HAT")=""
DEV S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q
G:'$D(IO("Q")) L1 K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
X ^%ZOSF("UCI") S ZTRTN="L1^AGCHART",ZTUCI=Y,ZTDESC="PATIENTS BY CHART NUMBER at "_$P(^AUTTLOC(DUZ(2),0),U,2)_"." F G="AGBEG","AGEND" S ZTSAVE(G)=""
D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGBEG,AGEND,AGIO,G,ZTDESC,ZTRTN,ZTSK,ZTUCI D ^%ZISC
Q
L1 ;EP - From TaskMan.
S (AGPGPG,AGTOT)=0,AGCH=AGBEG-1,AG("LOC")=$P(^DIC(4,DUZ(2),0),U),AG("USR")=$P(^VA(200,DUZ,0),U),AG("USRLOC")=AG("USR")_$J("",40-($L(AG("LOC"))\2)-$L(AG("USR")))_AG("LOC") K AG("LOC"),AG("USR")
X ^%ZOSF("UCI") S X="UCI: "_$P(Y,",",1) D CTR^AG S AGUCI=X,AGBM=IOSL-10 I $D(AGIO),AGIO=IO S AGBM=IOSL-4
U IO D NOW^AG S X="as of "_AGTIME D CTR^AG S AGTIME=X,X="Chart numbers from "_AGBEG_" to "_AGEND D CTR^AG S AGHDG=X D HDR
L2 S AGCH=$O(^AUPNPAT("D",AGCH)) G END:AGCH=""!(AGCH>AGEND) S DFN=0
L3 S DFN=$O(^AUPNPAT("D",AGCH,DFN)) G L2:DFN="" S AGFAC=0
L4 S AGFAC=$O(^AUPNPAT("D",AGCH,DFN,AGFAC)) G L3:AGFAC="",L4:AGFAC'=DUZ(2)
W $P(^DPT(DFN,0),U)," " S AG=$S($P(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]"":"*",1:"") D DEAD^AGMAN S AG=AG_$S($D(AG("DEAD")):"D",1:"") W:AG]"" "(",AG,")"
W ?44,$J($P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),6)
;K ^UTILITY("DIQ1",$J) S DIC=2,DR=.09,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?53,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?67,$J(^(DR),10)
;K ^UTILITY("DIQ1",$J) S DIC=9000001,DR=1107.3,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?53,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?67,$J(^(DR),10) ;IHS/SD/TPF AG*7.1*4
K ^UTILITY("DIQ1",$J) S DIC=9000001,DR=1107.3,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?53,^(DR) S DIC=2,DR=.03 D EN^DIQ1 W:$D(^(DR)) ?67,$J(^(DR),10) ;IHS/SD/TPF AG*7.1*5
W ! S AGTOT=AGTOT+1 I $Y>AGBM D RTRN^AG G:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) K D HDR
G L4
END W !!,"Total Patients on this List: ",AGTOT K AG("HAT") D RTRN^AG W $$S^AGVDF("IOF")
K D ^%ZISC K AG,AGBEG,AGEND,AGIO,AGTIME,AGTOT,AGBM,AGCH,DA,DFN,DIC,DLOUT,DR,DUOUT,AGFAC,AGHDG,AGPGPG,AGUCI,AGUSRLOC,X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD
Q
HDR S AGPGPG=AGPGPG+1 W $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG,!?19,"REGISTERED PATIENTS - CHART NUMBER LISTING",!,AGUCI,!?24,"('*' = INACTIVE, 'D' = DECEASED)",!,AGHDG,!,AGTIME,!!
W !!?18,"Name",?45,"IHS #",?57,"SSN",?71,"DOB",!,"----------------------------------------",?44,"------",?53,"-----------",?67,"------------",!
Q
QUES W !!,"YOU MAY PRINT THIS REPORT FOR A LIMITED RANGE OF CHART NUMBERS, IF YOU WISH.",!,"SIMPLY ENTER A STARTING NUMBER AND PRESS RETURN. YOU WILL THEN BE ASKED FOR",!,"THE ENDING NUMBER."
G C
AGCHART ; IHS/ASDS/EFG - LIST OF REGISTERED PATIENTS BY CHART NUMBER ;
+1 ;;7.1;PATIENT REGISTRATION;**4,5**;AUG 25,2005
C WRITE !!,"START WITH WHAT CHART NUMBER? Print All Charts// "
DO READ^AG
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DFOUT)
GOTO K
IF $DATA(DQOUT)
GOTO QUES
IF $DATA(DLOUT)
SET AGBEG=0
SET AGEND=999999999
GOTO E
+1 IF +Y<1
GOTO QUES
SET AGBEG=+Y
D WRITE !!,"END WITH WHAT CHART NUMBER? Last One// "
DO READ^AG
IF $DATA(DTOUT)!$DATA(DFOUT)
GOTO K
IF $DATA(DUOUT)
GOTO C
IF $DATA(DQOUT)
GOTO QUES
IF $DATA(DLOUT)
SET AGEND=999999999
GOTO E
+1 IF +Y<AGBEG
WRITE !!,*7,"THE ENDING NUMBER IS LESS THAN THE BEGINNING NUMBER."
GOTO C
+2 SET AGEND=+Y
E SET AGIO=IO
SET AG("HAT")=""
DEV SET %ZIS="OPQ"
DO ^%ZIS
IF POP
SET IOP=ION
DO ^%ZIS
QUIT
+1 IF '$DATA(IO("Q"))
GOTO L1
KILL IO("Q")
IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+2 XECUTE ^%ZOSF("UCI")
SET ZTRTN="L1^AGCHART"
SET ZTUCI=Y
SET ZTDESC="PATIENTS BY CHART NUMBER at "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."
FOR G="AGBEG","AGEND"
SET ZTSAVE(G)=""
+3 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
KILL AG,AGBEG,AGEND,AGIO,G,ZTDESC,ZTRTN,ZTSK,ZTUCI
DO ^%ZISC
+4 QUIT
L1 ;EP - From TaskMan.
+1 SET (AGPGPG,AGTOT)=0
SET AGCH=AGBEG-1
SET AG("LOC")=$PIECE(^DIC(4,DUZ(2),0),U)
SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)
SET AG("USRLOC")=AG("USR")_$JUSTIFY("",40-($LENGTH(AG("LOC"))\2)-$LENGTH(AG("USR")))_AG("LOC")
KILL AG("LOC"),AG("USR")
+2 XECUTE ^%ZOSF("UCI")
SET X="UCI: "_$PIECE(Y,",",1)
DO CTR^AG
SET AGUCI=X
SET AGBM=IOSL-10
IF $DATA(AGIO)
IF AGIO=IO
SET AGBM=IOSL-4
+3 USE IO
DO NOW^AG
SET X="as of "_AGTIME
DO CTR^AG
SET AGTIME=X
SET X="Chart numbers from "_AGBEG_" to "_AGEND
DO CTR^AG
SET AGHDG=X
DO HDR
L2 SET AGCH=$ORDER(^AUPNPAT("D",AGCH))
IF AGCH=""!(AGCH>AGEND)
GOTO END
SET DFN=0
L3 SET DFN=$ORDER(^AUPNPAT("D",AGCH,DFN))
IF DFN=""
GOTO L2
SET AGFAC=0
L4 SET AGFAC=$ORDER(^AUPNPAT("D",AGCH,DFN,AGFAC))
IF AGFAC=""
GOTO L3
IF AGFAC'=DUZ(2)
GOTO L4
+1 WRITE $PIECE(^DPT(DFN,0),U)," "
SET AG=$SELECT($PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]"":"*",1:"")
DO DEAD^AGMAN
SET AG=AG_$SELECT($DATA(AG("DEAD")):"D",1:"")
IF AG]""
WRITE "(",AG,")"
+2 WRITE ?44,$JUSTIFY($PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),6)
+3 ;K ^UTILITY("DIQ1",$J) S DIC=2,DR=.09,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?53,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?67,$J(^(DR),10)
+4 ;K ^UTILITY("DIQ1",$J) S DIC=9000001,DR=1107.3,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?53,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?67,$J(^(DR),10) ;IHS/SD/TPF AG*7.1*4
+5 ;IHS/SD/TPF AG*7.1*5
KILL ^UTILITY("DIQ1",$JOB)
SET DIC=9000001
SET DR=1107.3
SET DA=DFN
DO EN^DIQ1
IF $DATA(^(DR))
WRITE ?53,^(DR)
SET DIC=2
SET DR=.03
DO EN^DIQ1
IF $DATA(^(DR))
WRITE ?67,$JUSTIFY(^(DR),10)
+6 WRITE !
SET AGTOT=AGTOT+1
IF $Y>AGBM
DO RTRN^AG
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
GOTO K
DO HDR
+7 GOTO L4
END WRITE !!,"Total Patients on this List: ",AGTOT
KILL AG("HAT")
DO RTRN^AG
WRITE $$S^AGVDF("IOF")
K DO ^%ZISC
KILL AG,AGBEG,AGEND,AGIO,AGTIME,AGTOT,AGBM,AGCH,DA,DFN,DIC,DLOUT,DR,DUOUT,AGFAC,AGHDG,AGPGPG,AGUCI,AGUSRLOC,X,Y
IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+1 QUIT
HDR SET AGPGPG=AGPGPG+1
WRITE $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG,!?19,"REGISTERED PATIENTS - CHART NUMBER LISTING",!,AGUCI,!?24,"('*' = INACTIVE, 'D' = DECEASED)",!,AGHDG,!,AGTIME,!!
+1 WRITE !!?18,"Name",?45,"IHS #",?57,"SSN",?71,"DOB",!,"----------------------------------------",?44,"------",?53,"-----------",?67,"------------",!
+2 QUIT
QUES WRITE !!,"YOU MAY PRINT THIS REPORT FOR A LIMITED RANGE OF CHART NUMBERS, IF YOU WISH.",!,"SIMPLY ENTER A STARTING NUMBER AND PRESS RETURN. YOU WILL THEN BE ASKED FOR",!,"THE ENDING NUMBER."
+1 GOTO C
