AGALPHA1.m

AGALPHA1 ; IHS/ASDS/EFG - ALPHA LIST OF ALL PATIENTS ;  

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

 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^AGALPHA1",ZTUCI=Y,ZTDESC="ALPHA LIST, ALL PATIENTS"_"."

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

 Q

L1 ;EP - From TaskMan.

 S (AGPGPG,AGNAME,AGTOT)=0,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,",",1) D CTR^AG S AGUCI=X D LINES^AG,NOW^AG S X="as of "_AGTIME D CTR^AG S AGTIME=X U IO D HDR

L2 S AGNAME=$O(^DPT("B",AGNAME)) G END:AGNAME="" S DFN=0

L3 S DFN=$O(^DPT("B",AGNAME,DFN)) G L2:DFN="",L3:'$D(^DPT(DFN,0)),L3:$P(^DPT(DFN,0),U)'=AGNAME,L3:$P(^DPT(DFN,0),U,19)>0 ;skip merged patient

 W $P(^DPT(DFN,0),U),"  " S AG="" I $D(^AUPNPAT(DFN,41,DUZ(2),0)),$P(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]"" S AG="*"

 D DEAD^AGMAN S AG=AG_$S($D(AG("DEAD")):"D",1:"") W:AG]"" "(",AG,")"

 ;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)

 ;K ^UTILITY("DIQ1",$J) S DIC=9000001,DR=1107.3,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?52,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?66,$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)) ?52,^(DR) S DIC=2,DR=.03 D EN^DIQ1 W:$D(^(DR)) ?66,$J(^(DR),10)   ;IHS/SD/TPF AG*7.1*5

 W !

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

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

 G L3

END W !!,"Total Patients: ",AGTOT K AG("HAT") D RTRN^AG W @IOF

K D ^%ZISC K AG,AGIO,AGTIME,AGBM,DA,AG("DENT"),DFN,DIC,DR,G,AGL,AG("LKDATA"),AG("LKERR"),AG("LOC"),AGNAME,AGPGPG,AGTOT,AGUCI,AG("USR"),X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD

 Q

HDR S AGPGPG=AGPGPG+1 W @IOF,!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"ALL PATIENTS - ALPHABETICAL LISTING",!,AGUCI,!?24,"('*' = INACTIVE), ('D' = DECEASED)",!,AGTIME,!

 W !!?3,"Name",?21,"IHS #",?30,"FACILITY",?56,"SSN",?70,"DOB",!!,AG("="),!

 Q

AGALPHA1  ; IHS/ASDS/EFG - ALPHA LIST OF ALL PATIENTS ;  

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

 +2        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^AGALPHA1"

           SET ZTUCI=Y

           SET ZTDESC="ALPHA LIST, ALL PATIENTS"_"."

 +3        DO ^%ZTLOAD

           IF '$DATA(ZTSK)

               GOTO DEV

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

           DO ^%ZISC

 +4        QUIT 

L1        ;EP - From TaskMan.

 +1        SET (AGPGPG,AGNAME,AGTOT)=0

           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,",",1)

           DO CTR^AG

           SET AGUCI=X

           DO LINES^AG

           DO NOW^AG

           SET X="as of "_AGTIME

           DO CTR^AG

           SET AGTIME=X

           USE IO

           DO HDR

L2         SET AGNAME=$ORDER(^DPT("B",AGNAME))

           IF AGNAME=""

               GOTO END

           SET DFN=0

L3        ;skip merged patient

           SET DFN=$ORDER(^DPT("B",AGNAME,DFN))

           IF DFN=""

               GOTO L2

           IF '$DATA(^DPT(DFN,0))

               GOTO L3

           IF $PIECE(^DPT(DFN,0),U)'=AGNAME

               GOTO L3

           IF $PIECE(^DPT(DFN,0),U,19)>0

               GOTO L3

 +1        WRITE $PIECE(^DPT(DFN,0),U),"  "

           SET AG=""

           IF $DATA(^AUPNPAT(DFN,41,DUZ(2),0))

               IF $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]""

                   SET AG="*"

 +2        DO DEAD^AGMAN

           SET AG=AG_$SELECT($DATA(AG("DEAD")):"D",1:"")

           IF AG]""

               WRITE "(",AG,")"

 +3       ;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)

 +4       ;K ^UTILITY("DIQ1",$J) S DIC=9000001,DR=1107.3,DA=DFN D EN^DIQ1 W:$D(^(DR)) ?52,^(DR) S DR=.03 D EN^DIQ1 W:$D(^(DR)) ?66,$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 ?52,^(DR)

           SET DIC=2

           SET DR=.03

           DO EN^DIQ1

           IF $DATA(^(DR))

               WRITE ?66,$JUSTIFY(^(DR),10)

 +6        WRITE !

 +7        FOR AG=1:1

               SET DIC=9000001.41

               SET DA=DFN

               SET AG("DRENT")=AG

               SET DR=.02

               DO ^AGDICLK

               IF $DATA(AG("LKERR"))

                   QUIT 

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

               SET AG("DRENT")=AG

               SET DR=.01

               DO ^AGDICLK

               IF '$DATA(AG("LKERR"))

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

               WRITE !

 +8        SET AGTOT=AGTOT+1

           IF $Y>AGBM

               DO RTRN^AG

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

                   GOTO K

               DO HDR

 +9        GOTO L3

END        WRITE !!,"Total Patients: ",AGTOT

           KILL AG("HAT")

           DO RTRN^AG

           WRITE @IOF

K          DO ^%ZISC

           KILL AG,AGIO,AGTIME,AGBM,DA,AG("DENT"),DFN,DIC,DR,G,AGL,AG("LKDATA"),AG("LKERR"),AG("LOC"),AGNAME,AGPGPG,AGTOT,AGUCI,AG("USR"),X,Y

           IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

 +1        QUIT 

HDR        SET AGPGPG=AGPGPG+1

           WRITE @IOF,!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?23,"ALL PATIENTS - ALPHABETICAL LISTING",!,AGUCI,!?24,"('*' = INACTIVE), ('D' = DECEASED)",!,AGTIME,!

 +1        WRITE !!?3,"Name",?21,"IHS #",?30,"FACILITY",?56,"SSN",?70,"DOB",!!,AG("="),!

 +2        QUIT