- 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
