AGGRPRT1 ; VNGT/HS/KDC - ;
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
; Copied from AGREPRT1
;
S AGBDT=AG("B")-.1,AG("FAC")=AGGDUZ2
D ^AGPATCNT
K DUOUT,DTOUT,DFOUT
D NOW^AG S X="as of : "_AGTIME D CTR^AG S AGTIME=X U IO G ^AGREPRT2:AG("TYPE")>2
X ^%ZOSF("UCI") S X="UCI: "_$P(Y,",") D CTR^AG S AGUCI=X,X=$P(^DIC(4,AGGDUZ2,0),U) D CTR^AG S AG("LOC")=X,AG("USR")=$P(^VA(200,DUZ,0),U),AGBM=IOSL-10 I $D(AGIO),AGIO=IO S AGBM=IOSL-4
S AGBDTS=AGBDT
D SCAN
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
D PRINT
G END
SCAN ;scan dates
S AGPGPG=0,(AG("NEW"),AG("KILL"),AG("EDIT"))=0
K ^TMP($J)
F S AGBDTS=$O(^AGPATCH(AGBDTS)),AGBDT=AGBDTS\1 Q:(AGBDT=0!(AGBDT>AG("E"))) Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D LPAT
Q
LPAT ;loop patients
Q:'$D(^AGPATCH(AGBDTS,AGGDUZ2))
S AG("DFN")=0 F S AG("DFN")=$O(^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN"))) Q:AG("DFN")="" Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D PAT
Q
PAT ;individual patient
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
S AG("GL")=^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN")) I $P(AG("GL"),U,2)]""&($P(AG("GL"),U,3)="") S ^TMP($J,AGBDT,"K")=1+$G(^TMP($J,AGBDT,"K")) Q
Q:'$D(^AUPNPAT(AG("DFN"),0))!'$D(^AUPNPAT(AG("DFN"),41,AGGDUZ2,0))
I AG("GL")="NEW" S ^TMP($J,AGBDT,"N")=1+$G(^TMP($J,AGBDT,"N")),^TMP($J,AGBDT,"N",AG("DFN"))="" Q
S:'$D(^TMP($J,AGBDT,"E",AG("DFN"))) ^TMP($J,AGBDT,"E",AG("DFN"))="",^TMP($J,AGBDT,"E")=1+$G(^TMP($J,AGBDT,"E"))
Q
PRINT ;
S (AG("EDIT"),AG("KILL"),AG("NEW"))=0
S AGBDT="" F S AGBDT=$O(^TMP($J,AGBDT)) Q:'AGBDT Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D
.S AG("EDIT")=AG("EDIT")+$G(^TMP($J,AGBDT,"E"))
.S AG("NEW")=AG("NEW")+$G(^TMP($J,AGBDT,"N"))
.S AG("KILL")=AG("KILL")+$G(^TMP($J,AGBDT,"K"))
S AG("HD")="Statistics totals" D HDR
U IO W !,"Total patients Added :",?30,AG("NEW")
W !,"Total patients Edited :",?30,AG("EDIT")
W !,"Total patients Removed :",?30,AG("KILL")
W !,"Total patients Registered :",?30,AG("TOTPAT")
;D RTRN^AG
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
Q:AG("TYPE")=1
S AGBDT="" F S AGBDT=$O(^TMP($J,AGBDT)) Q:'AGBDT Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D DAY
Q
DAY ;print a days information
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
S ^TMP($J,AGBDT,"N")=$G(^TMP($J,AGBDT,"N"))
S ^TMP($J,AGBDT,"E")=$G(^TMP($J,AGBDT,"E"))
S ^TMP($J,AGBDT,"K")=$G(^TMP($J,AGBDT,"K"))
D HDR
W !!,?4,"NEW PATIENTS REGISTERED: ",^TMP($J,AGBDT,"N"),!!,?7,"PATIENT FILES EDITED: ",^TMP($J,AGBDT,"E"),!! I ^TMP($J,AGBDT,"K")>0 W ?6,"PATIENT FILES DELETED: ",^TMP($J,AGBDT,"K"),!!
W ?2,"TOTAL PATIENTS REGISTERED: ",AG("TOTPAT"),!!
;D RTRN^AG
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
D NEW,EDIT
Q
NEW I ^TMP($J,AGBDT,"N")'>0 Q
S AG("HD")="THE FOLLOWING PATIENTS WERE ADDED:" D HDR,UCI1
F DFN=0:0 S DFN=$O(^TMP($J,AGBDT,"N",DFN)) Q:'DFN D FILE Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
;D RTRN^AG
Q
EDIT Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
Q:^TMP($J,AGBDT,"E")'>0
S AG("HD")="THE FOLLOWING PATIENT FILES WERE EDITED:" D HDR,UCI1
S DFN=0 F S DFN=$O(^TMP($J,AGBDT,"E",DFN)) Q:'DFN D FILE Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
;D RTRN^AG
Q
END K AG("HAT") ;D RTRN^AG
;W $$S^AGVDF("IOF") *** commited out to prevent control characters
END1 D ^%ZISC
K ^UTILITY("DIQ1",$J),^TMP($J),A,AG,AGBDT,AGIO,AGTIME,AGBM,DA,DIC,DR,AG("LOC"),AGPGPG,AGUCI,AG("USR"),X,Y
Q
FILE W ?5,$P(^DPT(DFN,0),U),?43,$J($P(^AUPNPAT(DFN,41,AGGDUZ2,0),U,2),6)
;K ^UTILITY("DIQ1",$J) S DIC=2,DR=.09,DA=DFN D EN^DIQ1 I $D(^(DR)) W ?52,^(DR)
W ?52,$$GET1^DIQ(9000001,DFN_",",1107.3) ;IHS/SD/TPF AG*7.1*4
;S DR=.03 D EN^DIQ1 I $D(^(DR)) W ?66,$J(^(DR),10)
W ?66,$J($P($$GET1^DIQ(2,DFN_",",.03),"@"),10) ;IHS/SD/TPF AG*7.1*4
W ! ;I $Y>AGBM D RTRN^AG Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR
Q
HDR ;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(11+$L(Y))\2,"Report for ",Y,!!
;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$L(Y))\2,"Report from ",AGB," to ",AGE,!! ;BAR*1.8*4 IM26905
S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W !!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$L(Y))\2,"Report from ",AGB," to ",AGE,!! ;BAR*1.8*4 IM26905
Q
UCI1 I '$D(AG("TOP")) W ?80-$L(AG("HD"))\2,AG("HD"),!!,?13,"Name",?44,"IHS #",?56,"SSN",?70,"DOB",!,"-----------------------------------",?43,"------",?52,"-----------",?66,"------------",!
K AG("TOP")
Q
AGGRPRT1 ; VNGT/HS/KDC - ;
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ; Copied from AGREPRT1
+4 ;
+5 SET AGBDT=AG("B")-.1
SET AG("FAC")=AGGDUZ2
+6 DO ^AGPATCNT
+7 KILL DUOUT,DTOUT,DFOUT
+8 DO NOW^AG
SET X="as of : "_AGTIME
DO CTR^AG
SET AGTIME=X
USE IO
IF AG("TYPE")>2
GOTO ^AGREPRT2
+9 XECUTE ^%ZOSF("UCI")
SET X="UCI: "_$PIECE(Y,",")
DO CTR^AG
SET AGUCI=X
SET X=$PIECE(^DIC(4,AGGDUZ2,0),U)
DO CTR^AG
SET AG("LOC")=X
SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)
SET AGBM=IOSL-10
IF $DATA(AGIO)
IF AGIO=IO
SET AGBM=IOSL-4
+10 SET AGBDTS=AGBDT
+11 DO SCAN
+12 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+13 DO PRINT
+14 GOTO END
SCAN ;scan dates
+1 SET AGPGPG=0
SET (AG("NEW"),AG("KILL"),AG("EDIT"))=0
+2 KILL ^TMP($JOB)
+3 FOR
SET AGBDTS=$ORDER(^AGPATCH(AGBDTS))
SET AGBDT=AGBDTS\1
IF (AGBDT=0!(AGBDT>AG("E")))
QUIT
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
DO LPAT
+4 QUIT
LPAT ;loop patients
+1 IF '$DATA(^AGPATCH(AGBDTS,AGGDUZ2))
QUIT
+2 SET AG("DFN")=0
FOR
SET AG("DFN")=$ORDER(^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN")))
IF AG("DFN")=""
QUIT
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
DO PAT
+3 QUIT
PAT ;individual patient
+1 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+2 SET AG("GL")=^AGPATCH(AGBDTS,AGGDUZ2,AG("DFN"))
IF $PIECE(AG("GL"),U,2)]""&($PIECE(AG("GL"),U,3)="")
SET ^TMP($JOB,AGBDT,"K")=1+$GET(^TMP($JOB,AGBDT,"K"))
QUIT
+3 IF '$DATA(^AUPNPAT(AG("DFN"),0))!'$DATA(^AUPNPAT(AG("DFN"),41,AGGDUZ2,0))
QUIT
+4 IF AG("GL")="NEW"
SET ^TMP($JOB,AGBDT,"N")=1+$GET(^TMP($JOB,AGBDT,"N"))
SET ^TMP($JOB,AGBDT,"N",AG("DFN"))=""
QUIT
+5 IF '$DATA(^TMP($JOB,AGBDT,"E",AG("DFN")))
SET ^TMP($JOB,AGBDT,"E",AG("DFN"))=""
SET ^TMP($JOB,AGBDT,"E")=1+$GET(^TMP($JOB,AGBDT,"E"))
+6 QUIT
PRINT ;
+1 SET (AG("EDIT"),AG("KILL"),AG("NEW"))=0
+2 SET AGBDT=""
FOR
SET AGBDT=$ORDER(^TMP($JOB,AGBDT))
IF 'AGBDT
QUIT
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
Begin DoDot:1
+3 SET AG("EDIT")=AG("EDIT")+$GET(^TMP($JOB,AGBDT,"E"))
+4 SET AG("NEW")=AG("NEW")+$GET(^TMP($JOB,AGBDT,"N"))
+5 SET AG("KILL")=AG("KILL")+$GET(^TMP($JOB,AGBDT,"K"))
End DoDot:1
+6 SET AG("HD")="Statistics totals"
DO HDR
+7 USE IO
WRITE !,"Total patients Added :",?30,AG("NEW")
+8 WRITE !,"Total patients Edited :",?30,AG("EDIT")
+9 WRITE !,"Total patients Removed :",?30,AG("KILL")
+10 WRITE !,"Total patients Registered :",?30,AG("TOTPAT")
+11 ;D RTRN^AG
+12 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+13 IF AG("TYPE")=1
QUIT
+14 SET AGBDT=""
FOR
SET AGBDT=$ORDER(^TMP($JOB,AGBDT))
IF 'AGBDT
QUIT
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
DO DAY
+15 QUIT
DAY ;print a days information
+1 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+2 SET ^TMP($JOB,AGBDT,"N")=$GET(^TMP($JOB,AGBDT,"N"))
+3 SET ^TMP($JOB,AGBDT,"E")=$GET(^TMP($JOB,AGBDT,"E"))
+4 SET ^TMP($JOB,AGBDT,"K")=$GET(^TMP($JOB,AGBDT,"K"))
+5 DO HDR
+6 WRITE !!,?4,"NEW PATIENTS REGISTERED: ",^TMP($JOB,AGBDT,"N"),!!,?7,"PATIENT FILES EDITED: ",^TMP($JOB,AGBDT,"E"),!!
IF ^TMP($JOB,AGBDT,"K")>0
WRITE ?6,"PATIENT FILES DELETED: ",^TMP($JOB,AGBDT,"K"),!!
+7 WRITE ?2,"TOTAL PATIENTS REGISTERED: ",AG("TOTPAT"),!!
+8 ;D RTRN^AG
+9 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+10 DO NEW
DO EDIT
+11 QUIT
NEW IF ^TMP($JOB,AGBDT,"N")'>0
QUIT
+1 SET AG("HD")="THE FOLLOWING PATIENTS WERE ADDED:"
DO HDR
DO UCI1
+2 FOR DFN=0:0
SET DFN=$ORDER(^TMP($JOB,AGBDT,"N",DFN))
IF 'DFN
QUIT
DO FILE
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+3 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+4 ;D RTRN^AG
+5 QUIT
EDIT IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+1 IF ^TMP($JOB,AGBDT,"E")'>0
QUIT
+2 SET AG("HD")="THE FOLLOWING PATIENT FILES WERE EDITED:"
DO HDR
DO UCI1
+3 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,AGBDT,"E",DFN))
IF 'DFN
QUIT
DO FILE
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+4 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+5 ;D RTRN^AG
+6 QUIT
END ;D RTRN^AG
KILL AG("HAT")
+1 ;W $$S^AGVDF("IOF") *** commited out to prevent control characters
END1 DO ^%ZISC
+1 KILL ^UTILITY("DIQ1",$JOB),^TMP($JOB),A,AG,AGBDT,AGIO,AGTIME,AGBM,DA,DIC,DR,AG("LOC"),AGPGPG,AGUCI,AG("USR"),X,Y
+2 QUIT
FILE WRITE ?5,$PIECE(^DPT(DFN,0),U),?43,$JUSTIFY($PIECE(^AUPNPAT(DFN,41,AGGDUZ2,0),U,2),6)
+1 ;K ^UTILITY("DIQ1",$J) S DIC=2,DR=.09,DA=DFN D EN^DIQ1 I $D(^(DR)) W ?52,^(DR)
+2 ;IHS/SD/TPF AG*7.1*4
WRITE ?52,$$GET1^DIQ(9000001,DFN_",",1107.3)
+3 ;S DR=.03 D EN^DIQ1 I $D(^(DR)) W ?66,$J(^(DR),10)
+4 ;IHS/SD/TPF AG*7.1*4
WRITE ?66,$JUSTIFY($PIECE($$GET1^DIQ(2,DFN_",",.03),"@"),10)
+5 ;I $Y>AGBM D RTRN^AG Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR
WRITE !
+6 QUIT
HDR ;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(11+$L(Y))\2,"Report for ",Y,!!
+1 ;S AGPGPG=AGPGPG+1,Y=AGBDT D DD^%DT W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$L(Y))\2,"Report from ",AGB," to ",AGE,!! ;BAR*1.8*4 IM26905
+2 ;BAR*1.8*4 IM26905
SET AGPGPG=AGPGPG+1
SET Y=AGBDT
DO DD^%DT
WRITE !!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"DAILY REGISTRATION ACTIVITY REPORT",!,AGUCI,!,AGTIME,!!,?80-(36+$LENGTH(Y))\2,"Report from ",AGB," to ",AGE,!!
+3 QUIT
UCI1 IF '$DATA(AG("TOP"))
WRITE ?80-$LENGTH(AG("HD"))\2,AG("HD"),!!,?13,"Name",?44,"IHS #",?56,"SSN",?70,"DOB",!,"-----------------------------------",?43,"------",?52,"-----------",?66,"------------",!
+1 KILL AG("TOP")
+2 QUIT
