- 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
