- AGGRPRT2 ; VNGT/HS/KDC - ;
- ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
- ;
- ; Copied from AGREPRT2
- ;
- S AGBDT=AG("B"),AGB=AGBDT,AGEDT=AG("E"),AGBDT=AGBDT-.1,(AGTOTAL,AGPGPG)=0
- I '$D(AG("TOTPAT")) S AG("FAC")=AGGDUZ2 D ^AGPATCNT
- S 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
- 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
- K ^TMP("AGG",$J)
- 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
- NEW G
- ;X ^%ZOSF("UCI") S ZTRTN="^AGREPRT2",ZTUCI=Y,(AG,ZTDTH)=$H,ZTDESC="REGISTRATION ACTIVITY REPORT for "_$P(^AUTTLOC(AGGDUZ2,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,AGGDUZ2,DFN)) Q:'DFN D
- ..Q:'$D(^AUPNPAT(DFN,41,AGGDUZ2,0))
- ..I ^AGPATCH(AGBDT,AGGDUZ2,DFN)="NEW" S ^TMP("AGG",$J,DFN)="" Q
- ..Q:'$D(^AUPNPAT(DFN,0)) S X=^(0),AGED=$P(X,U,2)
- ..Q:AGED<AGBDT S ^TMP("AGG",$J,DFN)=""
- A3 ;EP - From TaskMan.
- S DFN=0,AGTOTAL=0 F S DFN=$O(^TMP("AGG",$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("AGG",$J,DFN)) Q:'DFN!($G(AG("QUIT"))) D
- .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 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") *** comited out to prevent control c
- K K AG,AGE,AGIO,AGTIME,AGB,AGBDT,AGED,AGEDT,AGREPRNT,AGTOTAL,B,AGBM,DA
- K DIC,DR,E,I,J,AGPGPG,AGUCI,AG("USR"),X,Y,Z,^TMP("AGG",$J),ZTQUEUED
- Q
- HDR S AGPGPG=AGPGPG+1 W 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
- AGGRPRT2 ; VNGT/HS/KDC - ;
- +1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
- +2 ;
- +3 ; Copied from AGREPRT2
- +4 ;
- +5 SET AGBDT=AG("B")
- SET AGB=AGBDT
- SET AGEDT=AG("E")
- SET AGBDT=AGBDT-.1
- SET (AGTOTAL,AGPGPG)=0
- +6 IF '$DATA(AG("TOTPAT"))
- SET AG("FAC")=AGGDUZ2
- DO ^AGPATCNT
- +7 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
- +8 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
- +9 KILL ^TMP("AGG",$JOB)
- +10 IF $DATA(AGREPRNT)
- GOTO A3
- IF $DATA(ZTQUEUED)
- GOTO A1
- +11 SET Y=AG("B")
- DO DD^%DT
- SET AG("B")=Y
- SET Y=AG("E")
- DO DD^%DT
- SET AG("E")=Y
- +12 NEW G
- +13 ;X ^%ZOSF("UCI") S ZTRTN="^AGREPRT2",ZTUCI=Y,(AG,ZTDTH)=$H,ZTDESC="REGISTRATION ACTIVITY REPORT for "_$P(^AUTTLOC(AGGDUZ2,0),U,2)_", "_AG("B")_" to "_AG("E")_"." F G="AG(""TYPE"")","AG(""B"")","AG(""E"")" S 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,AGGDUZ2,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +2 IF '$DATA(^AUPNPAT(DFN,41,AGGDUZ2,0))
- QUIT
- +3 IF ^AGPATCH(AGBDT,AGGDUZ2,DFN)="NEW"
- SET ^TMP("AGG",$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("AGG",$JOB,DFN)=""
- End DoDot:2
- End DoDot:1
- A3 ;EP - From TaskMan.
- +1 SET DFN=0
- SET AGTOTAL=0
- FOR
- SET DFN=$ORDER(^TMP("AGG",$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("AGG",$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,AGGDUZ2,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 ;I $Y>AGBM D
- WRITE !
- End DoDot:1
- +10 ;..D RTRN^AG I 'Y S AG("QUIT")=1 Q
- +11 ;..D HDR,HDR1
- +12 IF $GET(AG("QUIT"))
- GOTO K
- +13 ;D 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 ;D RTRN^AG
- KILL AG("HAT")
- +4 ;W $$S^AGVDF("IOF") *** comited out to prevent control c
- K KILL AG,AGE,AGIO,AGTIME,AGB,AGBDT,AGED,AGEDT,AGREPRNT,AGTOTAL,B,AGBM,DA
- +1 KILL DIC,DR,E,I,J,AGPGPG,AGUCI,AG("USR"),X,Y,Z,^TMP("AGG",$JOB),ZTQUEUED
- +2 QUIT
- HDR SET AGPGPG=AGPGPG+1
- WRITE 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