AGREPRT2 ; IHS/ASDS/EFG - ;
;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005
S AGBDT=AG("B"),AGB=AGBDT,AGEDT=AG("E"),AGBDT=AGBDT-.1,(AGTOTAL,AGPGPG)=0
I '$D(AG("TOTPAT")) S AG("FAC")=DUZ(2) D ^AGPATCNT
S X=$P(^DIC(4,DUZ(2),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
X ^%ZOSF("UCI") S X="UCI: "_$P(Y,",") D CTR^AG S AGUCI=X,Y=AGB D DD^%DT S B=Y,Y=AGEDT D DD^%DT S E=Y
G A3:$D(AGREPRNT),A1:$D(ZTQUEUED)
S Y=AG("B") D DD^%DT S AG("B")=Y,Y=AG("E") D DD^%DT S AG("E")=Y
X ^%ZOSF("UCI") S ZTRTN="^AGREPRT2",ZTUCI=Y,(AG,ZTDTH)=$H,ZTDESC="REGISTRATION ACTIVITY REPORT for "_$P(^AUTTLOC(DUZ(2),0),U,2)_", "_AG("B")_" to "_AG("E")_"." F G="AG(""TYPE"")","AG(""B"")","AG(""E"")" S ZTSAVE(G)=""
A1 F S AGBDT=$O(^AGPATCH(AGBDT)) Q:'AGBDT!((AGBDT\1)>AGEDT) D
.S DFN=0 F S DFN=$O(^AGPATCH(AGBDT,DUZ(2),DFN)) Q:'DFN D
..Q:'$D(^AUPNPAT(DFN,41,DUZ(2),0))
..I ^AGPATCH(AGBDT,DUZ(2),DFN)="NEW" S ^TMP("AGREP",$J,DFN)="" Q
..Q:'$D(^AUPNPAT(DFN,0)) S X=^(0),AGED=$P(X,U,2)
..Q:AGED<AGBDT S ^TMP("AGREP",$J,DFN)=""
A3 ;EP - From TaskMan.
S DFN=0,AGTOTAL=0 F S DFN=$O(^TMP("AGREP",$J,DFN)) Q:'DFN!($G(AG("QUIT"))) S AGTOTAL=AGTOTAL+1
G END:AG("TYPE")=3
D HDR,HDR1
S DFN=0 F S DFN=$O(^TMP("AGREP",$J,DFN)) Q:'DFN!($G(AG("QUIT"))) D
.W ?5,$P(^DPT(DFN,0),U),?43,$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)) ?52,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?66,$J(^(DR),10)
.W ?52,$$GET1^DIQ(9000001,DFN_",",1107.3) ;IHS/SD/TPF AG*7.1*4
.W ?66,$J($P($$GET1^DIQ(2,DFN_",",.03),"@"),10) ;IHS/SD/TPF AG*7.1*4
.W ! I $Y>AGBM D
..D RTRN^AG I 'Y S AG("QUIT")=1 Q
..D HDR,HDR1
G:$G(AG("QUIT")) K
D RTRN^AG
END D HDR
W !!,"New Patients Registered from ",$E(AGB,4,5)_"/"_$E(AGB,6,7)_"/"_$E(AGB,2,3)," to ",$E(AGEDT,4,5)_"/"_$E(AGEDT,6,7)_"/"_$E(AGEDT,2,3)," Totaled : ",AGTOTAL
W !!,"TOTAL PATIENTS REGISTERED : ",AG("TOTPAT"),!!
K AG("HAT") D RTRN^AG W $$S^AGVDF("IOF")
K D ^%ZISC K AG,AGE,AGIO,AGTIME,AGB,AGBDT,AGED,AGEDT,AGREPRNT,AGTOTAL,B,AGBM,DA,DIC,DR,E,I,J,AGPGPG,AGUCI,AG("USR"),X,Y,Z,^TMP("AGREP",$J)
Q
HDR S AGPGPG=AGPGPG+1 W $$S^AGVDF("IOF"),AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?25,"NEW PATIENT REGISTRATION REPORT",!,AGUCI,!,AGTIME,!!?80-$L("Report from "_B_" thru "_E)/2,"Report from ",B," thru ",E,!!
Q
HDR1 W !?23,"The Following Patients Were Added: ",!!?13,"Name",?44,"IHS #",?56,"SSN",?70,"DOB",!,"-----------------------------------",?43,"------",?52,"-----------",?66,"------------",!
Q
AGREPRT2 ; IHS/ASDS/EFG - ;
+1 ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005
+2 SET AGBDT=AG("B")
SET AGB=AGBDT
SET AGEDT=AG("E")
SET AGBDT=AGBDT-.1
SET (AGTOTAL,AGPGPG)=0
+3 IF '$DATA(AG("TOTPAT"))
SET AG("FAC")=DUZ(2)
DO ^AGPATCNT
+4 SET X=$PIECE(^DIC(4,DUZ(2),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
+5 XECUTE ^%ZOSF("UCI")
SET X="UCI: "_$PIECE(Y,",")
DO CTR^AG
SET AGUCI=X
SET Y=AGB
DO DD^%DT
SET B=Y
SET Y=AGEDT
DO DD^%DT
SET E=Y
+6 IF $DATA(AGREPRNT)
GOTO A3
IF $DATA(ZTQUEUED)
GOTO A1
+7 SET Y=AG("B")
DO DD^%DT
SET AG("B")=Y
SET Y=AG("E")
DO DD^%DT
SET AG("E")=Y
+8 XECUTE ^%ZOSF("UCI")
SET ZTRTN="^AGREPRT2"
SET ZTUCI=Y
SET (AG,ZTDTH)=$HOROLOG
SET ZTDESC="REGISTRATION ACTIVITY REPORT for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_", "_AG("B")_" to "_AG("E")_"."
FOR G="AG(""TYPE"")","AG(""B"")","AG(""E"")"
SET ZTSAVE(G)=""
A1 FOR
SET AGBDT=$ORDER(^AGPATCH(AGBDT))
IF 'AGBDT!((AGBDT\1)>AGEDT)
QUIT
Begin DoDot:1
+1 SET DFN=0
FOR
SET DFN=$ORDER(^AGPATCH(AGBDT,DUZ(2),DFN))
IF 'DFN
QUIT
Begin DoDot:2
+2 IF '$DATA(^AUPNPAT(DFN,41,DUZ(2),0))
QUIT
+3 IF ^AGPATCH(AGBDT,DUZ(2),DFN)="NEW"
SET ^TMP("AGREP",$JOB,DFN)=""
QUIT
+4 IF '$DATA(^AUPNPAT(DFN,0))
QUIT
SET X=^(0)
SET AGED=$PIECE(X,U,2)
+5 IF AGED<AGBDT
QUIT
SET ^TMP("AGREP",$JOB,DFN)=""
End DoDot:2
End DoDot:1
A3 ;EP - From TaskMan.
+1 SET DFN=0
SET AGTOTAL=0
FOR
SET DFN=$ORDER(^TMP("AGREP",$JOB,DFN))
IF 'DFN!($GET(AG("QUIT")))
QUIT
SET AGTOTAL=AGTOTAL+1
+2 IF AG("TYPE")=3
GOTO END
+3 DO HDR
DO HDR1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("AGREP",$JOB,DFN))
IF 'DFN!($GET(AG("QUIT")))
QUIT
Begin DoDot:1
+5 WRITE ?5,$PIECE(^DPT(DFN,0),U),?43,$JUSTIFY($PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),6)
+6 ;K ^UTILITY("DIQ1",$J) S DIC=2,DR=.09,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?52,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?66,$J(^(DR),10)
+7 ;IHS/SD/TPF AG*7.1*4
WRITE ?52,$$GET1^DIQ(9000001,DFN_",",1107.3)
+8 ;IHS/SD/TPF AG*7.1*4
WRITE ?66,$JUSTIFY($PIECE($$GET1^DIQ(2,DFN_",",.03),"@"),10)
+9 WRITE !
IF $Y>AGBM
Begin DoDot:2
+10 DO RTRN^AG
IF 'Y
SET AG("QUIT")=1
QUIT
+11 DO HDR
DO HDR1
End DoDot:2
End DoDot:1
+12 IF $GET(AG("QUIT"))
GOTO K
+13 DO RTRN^AG
END DO HDR
+1 WRITE !!,"New Patients Registered from ",$EXTRACT(AGB,4,5)_"/"_$EXTRACT(AGB,6,7)_"/"_$EXTRACT(AGB,2,3)," to ",$EXTRACT(AGEDT,4,5)_"/"_$EXTRACT(AGEDT,6,7)_"/"_$EXTRACT(AGEDT,2,3)," Totaled : ",AGTOTAL
+2 WRITE !!,"TOTAL PATIENTS REGISTERED : ",AG("TOTPAT"),!!
+3 KILL AG("HAT")
DO RTRN^AG
WRITE $$S^AGVDF("IOF")
K DO ^%ZISC
KILL AG,AGE,AGIO,AGTIME,AGB,AGBDT,AGED,AGEDT,AGREPRNT,AGTOTAL,B,AGBM,DA,DIC,DR,E,I,J,AGPGPG,AGUCI,AG("USR"),X,Y,Z,^TMP("AGREP",$JOB)
+1 QUIT
HDR SET AGPGPG=AGPGPG+1
WRITE $$S^AGVDF("IOF"),AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?25,"NEW PATIENT REGISTRATION REPORT",!,AGUCI,!,AGTIME,!!?80-$LENGTH("Report from "_B_" thru "_E)/2,"Report from ",B," thru ",E,!!
+1 QUIT
HDR1 WRITE !?23,"The Following Patients Were Added: ",!!?13,"Name",?44,"IHS #",?56,"SSN",?70,"DOB",!,"-----------------------------------",?43,"------",?52,"-----------",?66,"------------",!
+1 QUIT
