- ADGSIL1 ; IHS/ADC/PDW/ENM - SI/DNR LISTING ; [ 03/25/1999 11:48 AM ]
- ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- ;
- W @IOF,!!! K ^TMP("DGZSIL",$J)
- W ?10,"PATIENTS CURRENTLY ON SERIOUSLY ILL/DO NOT RESUSCITATE LIST",!!
- A ; -- main
- D ZIS I POP D Q Q
- I $D(IO("Q")) D QUE,Q Q
- D LW,WRT,Q Q
- ;
- START ; -- queued output driver
- K ^TMP("DGZSIL",$J)
- D LW,WRT,Q Q
- ;
- LW ; -- loop inpatients
- N WD,DFN,WARD,NAME,TS,PR,CON,CDT,UTL,N,X
- S WARD="" F S WARD=$O(^DPT("CN",WARD)) Q:WARD="" D
- . S DFN=0 F S DFN=$O(^DPT("CN",WARD,DFN)) Q:'DFN D VAR
- Q
- ;
- VAR ;
- Q:'$D(^DPT(DFN,"DAC")) Q:$P(^("DAC"),U)="" S N=^("DAC")
- S NAME=$P($G(^DPT(DFN,0)),U),TS=$G(^(.103)),PR=$G(^(.104))
- S WD=$O(^DIC(42,"B",WARD,0)),CON=$P(N,U),CDT=$P(N,U,2)
- S UTL=$$AGE_U_TS_U_PR_U_$$HRCN^ADGF_U_WARD_U_CDT
- I CON="S"!(CON="B") S ^TMP("DGZSIL",$J,1,NAME,DFN)=UTL
- I CON="D"!(CON="B") S ^TMP("DGZSIL",$J,2,NAME,DFN)=UTL
- Q
- ;
- WRT ; -- loop utl
- N WD,DFN,WARD,NAME,TS,PR,CON,CDT,UTL,N,X
- U IO D HD S SI=0 F S SI=$O(^TMP("DGZSIL",$J,SI)) Q:'SI D
- . W !!?28,$$HD1,!
- . S NAME="" F S NAME=$O(^TMP("DGZSIL",$J,SI,NAME)) Q:NAME="" D
- .. S DFN=0 F S DFN=$O(^TMP("DGZSIL",$J,SI,NAME,DFN)) Q:'DFN D 1 Q:$D(DIRUT)
- Q
- ;
- 1 S N=^TMP("DGZSIL",$J,SI,NAME,DFN)
- W !,$E(NAME,1,20),?23,$P(N,U,4)
- W ?32,$E($P($G(^VA(200,+$P(N,U,3),0)),U),1,12)
- W ?48,$P(N,U),?57,$P(N,U,5),?63,$E($G(^DIC(45.7,+$P(N,U,2),0)),1,3)
- W ?69,$E($P(N,U,6),4,5)_"/"_$E($P(N,U,6),6,7)_"/"_$E($P(N,U,6),2,3)
- I $Y>(IOSL-7) D NPG
- Q
- ;
- HD ; -- heading
- I IOST["C-" W @IOF
- W ?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- W !!?22,"SERIOUSLY ILL/DO NOT RESUSCITATE LIST",!
- W ?34,"for ",$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),!!
- W !,"Patient Name",?23,"Chart #",?32,"Provider",?48,"Age"
- W ?57,"WD",?63,"SRV",?69,"Entered" Q
- ;
- ZIS ; -- device selection
- S %ZIS="PQ" D ^%ZIS Q
- ;
- QUE ; -- queued output
- S ZTRTN="START^ADGSIL1",ZTDESC="SI/DNR LIST" D ^%ZTLOAD Q
- ;
- NPG ; -- end of page
- I IOST'?1"C-".E D HD Q
- K DIR S DIR(0)="E" D ^DIR D:'$D(DIRUT) HD Q
- ;
- Q ; -- cleanup
- I IOST?1"C-".E D PRTOPT^ADGVAR
- W @IOF D ^%ZISC,HOME^%ZIS K ZTSK,IO("Q") Q
- ;
- AGE() ; -- age
- N X,DIC,DR,DA
- K ^UTILITY("DIQ1",$J) S DIC=9000001,DR=1102.98,DA=DFN D EN^DIQ1
- S X=^UTILITY("DIQ1",$J,9000001,DFN,1102.98) K ^UTILITY("DIQ1",$J)
- Q X
- ;
- HD1() ; -- heading
- Q $S(SI=1:" ***SERIOUSLY ILL***",1:"***DO NOT RESUSCITATE***")
- ADGSIL1 ; IHS/ADC/PDW/ENM - SI/DNR LISTING ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
- +2 ;
- +3 WRITE @IOF,!!!
- KILL ^TMP("DGZSIL",$JOB)
- +4 WRITE ?10,"PATIENTS CURRENTLY ON SERIOUSLY ILL/DO NOT RESUSCITATE LIST",!!
- A ; -- main
- +1 DO ZIS
- IF POP
- DO Q
- QUIT
- +2 IF $DATA(IO("Q"))
- DO QUE
- DO Q
- QUIT
- +3 DO LW
- DO WRT
- DO Q
- QUIT
- +4 ;
- START ; -- queued output driver
- +1 KILL ^TMP("DGZSIL",$JOB)
- +2 DO LW
- DO WRT
- DO Q
- QUIT
- +3 ;
- LW ; -- loop inpatients
- +1 NEW WD,DFN,WARD,NAME,TS,PR,CON,CDT,UTL,N,X
- +2 SET WARD=""
- FOR
- SET WARD=$ORDER(^DPT("CN",WARD))
- IF WARD=""
- QUIT
- Begin DoDot:1
- +3 SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("CN",WARD,DFN))
- IF 'DFN
- QUIT
- DO VAR
- End DoDot:1
- +4 QUIT
- +5 ;
- VAR ;
- +1 IF '$DATA(^DPT(DFN,"DAC"))
- QUIT
- IF $PIECE(^("DAC"),U)=""
- QUIT
- SET N=^("DAC")
- +2 SET NAME=$PIECE($GET(^DPT(DFN,0)),U)
- SET TS=$GET(^(.103))
- SET PR=$GET(^(.104))
- +3 SET WD=$ORDER(^DIC(42,"B",WARD,0))
- SET CON=$PIECE(N,U)
- SET CDT=$PIECE(N,U,2)
- +4 SET UTL=$$AGE_U_TS_U_PR_U_$$HRCN^ADGF_U_WARD_U_CDT
- +5 IF CON="S"!(CON="B")
- SET ^TMP("DGZSIL",$JOB,1,NAME,DFN)=UTL
- +6 IF CON="D"!(CON="B")
- SET ^TMP("DGZSIL",$JOB,2,NAME,DFN)=UTL
- +7 QUIT
- +8 ;
- WRT ; -- loop utl
- +1 NEW WD,DFN,WARD,NAME,TS,PR,CON,CDT,UTL,N,X
- +2 USE IO
- DO HD
- SET SI=0
- FOR
- SET SI=$ORDER(^TMP("DGZSIL",$JOB,SI))
- IF 'SI
- QUIT
- Begin DoDot:1
- +3 WRITE !!?28,$$HD1,!
- +4 SET NAME=""
- FOR
- SET NAME=$ORDER(^TMP("DGZSIL",$JOB,SI,NAME))
- IF NAME=""
- QUIT
- Begin DoDot:2
- +5 SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP("DGZSIL",$JOB,SI,NAME,DFN))
- IF 'DFN
- QUIT
- DO 1
- IF $DATA(DIRUT)
- QUIT
- End DoDot:2
- End DoDot:1
- +6 QUIT
- +7 ;
- 1 SET N=^TMP("DGZSIL",$JOB,SI,NAME,DFN)
- +1 WRITE !,$EXTRACT(NAME,1,20),?23,$PIECE(N,U,4)
- +2 WRITE ?32,$EXTRACT($PIECE($GET(^VA(200,+$PIECE(N,U,3),0)),U),1,12)
- +3 WRITE ?48,$PIECE(N,U),?57,$PIECE(N,U,5),?63,$EXTRACT($GET(^DIC(45.7,+$PIECE(N,U,2),0)),1,3)
- +4 WRITE ?69,$EXTRACT($PIECE(N,U,6),4,5)_"/"_$EXTRACT($PIECE(N,U,6),6,7)_"/"_$EXTRACT($PIECE(N,U,6),2,3)
- +5 IF $Y>(IOSL-7)
- DO NPG
- +6 QUIT
- +7 ;
- HD ; -- heading
- +1 IF IOST["C-"
- WRITE @IOF
- +2 WRITE ?11,"*****Confidential Patient Data Covered by Privacy Act*****"
- +3 WRITE !!?22,"SERIOUSLY ILL/DO NOT RESUSCITATE LIST",!
- +4 WRITE ?34,"for ",$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),!!
- +5 WRITE !,"Patient Name",?23,"Chart #",?32,"Provider",?48,"Age"
- +6 WRITE ?57,"WD",?63,"SRV",?69,"Entered"
- QUIT
- +7 ;
- ZIS ; -- device selection
- +1 SET %ZIS="PQ"
- DO ^%ZIS
- QUIT
- +2 ;
- QUE ; -- queued output
- +1 SET ZTRTN="START^ADGSIL1"
- SET ZTDESC="SI/DNR LIST"
- DO ^%ZTLOAD
- QUIT
- +2 ;
- NPG ; -- end of page
- +1 IF IOST'?1"C-".E
- DO HD
- QUIT
- +2 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF '$DATA(DIRUT)
- DO HD
- QUIT
- +3 ;
- Q ; -- cleanup
- +1 IF IOST?1"C-".E
- DO PRTOPT^ADGVAR
- +2 WRITE @IOF
- DO ^%ZISC
- DO HOME^%ZIS
- KILL ZTSK,IO("Q")
- QUIT
- +3 ;
- AGE() ; -- age
- +1 NEW X,DIC,DR,DA
- +2 KILL ^UTILITY("DIQ1",$JOB)
- SET DIC=9000001
- SET DR=1102.98
- SET DA=DFN
- DO EN^DIQ1
- +3 SET X=^UTILITY("DIQ1",$JOB,9000001,DFN,1102.98)
- KILL ^UTILITY("DIQ1",$JOB)
- +4 QUIT X
- +5 ;
- HD1() ; -- heading
- +1 QUIT $SELECT(SI=1:" ***SERIOUSLY ILL***",1:"***DO NOT RESUSCITATE***")
