AGTEMPP.m

AGTEMPP ; IHS/ASDS/EFG - PRINT LIST OF TEMPORARY CHART # PATIENTS ;  

 ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005

 I $O(^AUPNPAT("D",999999))="" W "At this time, there are no patients with temporary chart numbers.",!!,"Press the RETURN key to continue. " R Y:30 Q

 S AGIO=IO,AG("HAT")=""

DEV S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q

 G:'$D(IO("Q")) START 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="START^AGTEMPP",ZTUCI=Y,ZTDESC="TEMPORARY HRNs for "_$P(^AUTTLOC(DUZ(2),0),U,2)_"." F G="DUZ" S ZTSAVE(G)=""

 D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGIO,ZTDESC,ZTRTN,ZTSK,ZTUCI D ^%ZISC

 Q

START ;EP - From TaskMan.

 S (AGPGPG,T)=0,AGTEMP=999999,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

 U IO D NOW^AG S X="as of "_AGTIME D CTR^AG S AGTIME=X D HDR

E K ^UTILITY("DIQ1",$J) S AGTEMP=$O(^AUPNPAT("D",AGTEMP)) G END:AGTEMP="" S DFN=$O(^AUPNPAT("D",AGTEMP,0)) G E:DFN=""

 W:$D(^DPT(DFN,0)) $P(^(0),U)

 ;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,^(DR)

 W ?52,$$GET1^DIQ(9000001,DFN_",",1107.3) S DIC=2,DA=DFN,DR=.03 D EN^DIQ1 W:$D(^(DR)) ?66,^(DR)  ;IHS/SD/TPF AG*7.1*4

 W !

 F AG("II")=1:1 S DIC=9000001.41,DA=DFN,AG("DRENT")=AG("II"),DR=.02 D ^AGDICLK Q:$D(AG("LKERR"))  W ?20,$J(AG("LKPRINT"),6) S AG("DRENT")=AG("II"),DR=.01 D ^AGDICLK W:$D(AG("LKPRINT")) ?30,$P(^DIC(4,AG("LKPRINT"),0),U) W !

 S T=T+1 I $Y>AGBM D RTRN^AG G:$D(DUOUT)!$D(DFOUT)!$D(DTOUT) END1 D HDR

 G E

END W !!,"Total patients with temporary chart numbers: ",T K AG("HAT") D RTRN^AG W $$S^AGVDF("IOF")

END1 D ^%ZISC K AG,AGBM,AGIO,AGTIME,C,DA,AG("DENT"),DFN,DIC,DLOUT,DR,G,AGL,AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AG("LOC"),N,AGUCI,AG("USR"),AGPCC,AGPGPG,T,AGTEMP,X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD

 Q

HDR S AGPGPG=AGPGPG+1,AG("LINE")="=" W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?22,"PATIENTS WITH TEMPORARY CHART NUMBERS",!,AGUCI,!,AGTIME,!!!!?3,"Name",?21,"IHS #",?30,"FACILITY",?56,"SSN",?70,"DOB",! D LINE^AG

 Q

AGTEMPP   ; IHS/ASDS/EFG - PRINT LIST OF TEMPORARY CHART # PATIENTS ;  

 +1       ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005

 +2        IF $ORDER(^AUPNPAT("D",999999))=""

               WRITE "At this time, there are no patients with temporary chart numbers.",!!,"Press the RETURN key to continue. "

               READ Y:30

               QUIT 

 +3        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 START

           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="START^AGTEMPP"

           SET ZTUCI=Y

           SET ZTDESC="TEMPORARY HRNs for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."

           FOR G="DUZ"

               SET ZTSAVE(G)=""

 +3        DO ^%ZTLOAD

           IF '$DATA(ZTSK)

               GOTO DEV

           KILL AG,AGIO,ZTDESC,ZTRTN,ZTSK,ZTUCI

           DO ^%ZISC

 +4        QUIT 

START     ;EP - From TaskMan.

 +1        SET (AGPGPG,T)=0

           SET AGTEMP=999999

           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

 +2        XECUTE ^%ZOSF("UCI")

           SET X="UCI: "_$PIECE(Y,",")

           DO CTR^AG

           SET AGUCI=X

 +3        USE IO

           DO NOW^AG

           SET X="as of "_AGTIME

           DO CTR^AG

           SET AGTIME=X

           DO HDR

E          KILL ^UTILITY("DIQ1",$JOB)

           SET AGTEMP=$ORDER(^AUPNPAT("D",AGTEMP))

           IF AGTEMP=""

               GOTO END

           SET DFN=$ORDER(^AUPNPAT("D",AGTEMP,0))

           IF DFN=""

               GOTO E

 +1        IF $DATA(^DPT(DFN,0))

               WRITE $PIECE(^(0),U)

 +2       ;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,^(DR)

 +3       ;IHS/SD/TPF AG*7.1*4

           WRITE ?52,$$GET1^DIQ(9000001,DFN_",",1107.3)

           SET DIC=2

           SET DA=DFN

           SET DR=.03

           DO EN^DIQ1

           IF $DATA(^(DR))

               WRITE ?66,^(DR)

 +4        WRITE !

 +5        FOR AG("II")=1:1

               SET DIC=9000001.41

               SET DA=DFN

               SET AG("DRENT")=AG("II")

               SET DR=.02

               DO ^AGDICLK

               IF $DATA(AG("LKERR"))

                   QUIT 

               WRITE ?20,$JUSTIFY(AG("LKPRINT"),6)

               SET AG("DRENT")=AG("II")

               SET DR=.01

               DO ^AGDICLK

               IF $DATA(AG("LKPRINT"))

                   WRITE ?30,$PIECE(^DIC(4,AG("LKPRINT"),0),U)

               WRITE !

 +6        SET T=T+1

           IF $Y>AGBM

               DO RTRN^AG

               IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)

                   GOTO END1

               DO HDR

 +7        GOTO E

END        WRITE !!,"Total patients with temporary chart numbers: ",T

           KILL AG("HAT")

           DO RTRN^AG

           WRITE $$S^AGVDF("IOF")

END1       DO ^%ZISC

           KILL AG,AGBM,AGIO,AGTIME,C,DA,AG("DENT"),DFN,DIC,DLOUT,DR,G,AGL,AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AG("LOC"),N,AGUCI,AG("USR"),AGPCC,AGPGPG,T,AGTEMP,X,Y

           IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

 +1        QUIT 

HDR        SET AGPGPG=AGPGPG+1

           SET AG("LINE")="="

           WRITE $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?22,"PATIENTS WITH TEMPORARY CHART NUMBERS",!,AGUCI,!,AGTIME,!!!!?3,"Name",?21,"IHS #",?30,"FACILITY",?56,"SSN",?70,"DOB",!

           DO LINE^AG

 +1        QUIT