- PSJMPRT ;BIR/MV-PRINT DRIVE FOR MDWS ;13 FEB 96 / 10:06 AM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;Loop thru TMP global to print report
- ;
- INIT ;
- Q:'$D(^TMP($J)) U IO
- NEW DRG,ND,PID,PID1,PPN,PPN1,PPNO,PRB,PRB1,PRBO,QST,TM,TM1,TMO,UD0,UD2,XNAME
- S PSJHL1="MEDICATIONS DUE WORKSHEET For: "
- S PSJHL2="Report from: "_$$ENDTC^PSGMI(PSGPLS)_" to: "_$$ENDTC^PSGMI(PSGPLF)_" "_"Report Date: "_$E($$ENDTC^PSGMI(DT),1,8)
- S XNAME="" S:PSGMTYPE[1 XNAME="ALL MEDS"
- S:PSGMTYPE[2 XNAME="NON-IV MEDs"
- I PSGMTYPE[3 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"IVPB"
- I PSGMTYPE[4 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"LVPs"
- I PSGMTYPE[5 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"TPNs"
- I PSGMTYPE[6 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"CHEMO (IV)"
- S PSJHL3="Continuous/One time Orders for: "_XNAME
- S PSJHL62="* Projected admin. times based on order's volume, flow rate, and start time."
- S (PSGPG,PSJNEED,PSJLN,PSJADTO,PSJATMEO)=0,(PPNO,PRBO,TMO)=""
- S (PPN,QST,DRG,TM,PSJPRB)="",PSJTOTLN=$S($E(IOST)="C":23,1:62)
- D @PSGSS
- I PSGPG,$G(PSJASTR) D
- . S X=$Y F X=X:1:PSJTOTLN W !
- . W !,PSJHL62 S PSJASTR=0
- Q
- ;
- P ;***Selected by Patients.
- F PSJADT=0:0 S PSJADT=$O(^TMP($J,PSJADT)) Q:'PSJADT F S PPN=$O(^TMP($J,PSJADT,PPN)) Q:PPN="" D
- . S PSJHL1=$P(PSJHL1,":")_": "_$P(PPN,U)
- . F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,PPN,PSJATME)) Q:'PSJATME F S QST=$O(^TMP($J,PSJADT,PPN,PSJATME,QST)) Q:QST="" D
- . . F S DRG=$O(^TMP($J,PSJADT,PPN,PSJATME,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
- Q
- ;
- G ;***Selected by Ward Group.
- S PSJHL1=PSJHL1_PSGWGNM
- ;
- W ;***Selected by Ward.
- S:PSGSS="W" PSJHL1=PSJHL1_PSGWN
- F PSJADT=0:0 S PSJADT=$O(^TMP($J,PSJADT)) Q:'PSJADT F S TM=$O(^TMP($J,PSJADT,TM)) Q:TM="" D @("W"_PSGRBADM)
- Q
- ;
- WA ;*** Selected by Ward and sort by Admin. time.
- F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PSJATME)) Q:'PSJATME F S PSJPRB=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB)) Q:PSJPRB="" D
- . F S PPN=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN)) Q:PPN="" F S QST=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST)) Q:QST="" D
- . .F S DRG=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
- Q
- ;
- WP ;*** Selected by Ward and sort by Patients.
- F S PPN=$O(^TMP($J,PSJADT,TM,PPN)) Q:PPN="" F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PPN,PSJATME)) Q:'PSJATME D
- . F S QST=$O(^TMP($J,PSJADT,TM,PPN,PSJATME,QST)) Q:QST="" F S DRG=$O(^TMP($J,PSJADT,TM,PPN,PSJATME,QST,DRG)) Q:DRG="" D
- . . D:'$G(PSJSTOP) PRT
- Q
- ;
- WR ;*** Selected by Ward and sort by Room-Bed.
- F S PSJPRB=$O(^TMP($J,PSJADT,TM,PSJPRB)) Q:PSJPRB="" F S PPN=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN)) Q:PPN="" D
- . F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME)) Q:'PSJATME F S QST=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST)) Q:QST="" D
- . . F S DRG=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
- Q
- ;
- PRT ;
- S ND=^(DRG),PSGP=+ND,ON=$P(ND,U,2),PID=$P(ND,U,3),PSGWN=$S(PSGSS="W":"",1:$P(ND,U,4)),PRB=$P(ND,U,5)
- I QST["V" D PRT^PSJMIV Q
- S ND=^TMP($J,QST,PSGP,ON),PSJDOS=$P(ND,U),PSJMR=$P(ND,U,2),PSJSCHE=$P(ND,U,3),PSJHOLD=$S($P(ND,U,4):1,1:0)
- S PSGLOD=$E($$ENDTC^PSGMI($P(ND,U,5)),1,5)
- I QST'["Z" S X=$$ENDTC^PSGMI($P(ND,U,6)),PSGLSD=$E(X,1,5)_$E(X,9,15),PSGLFD=$$ENDTC^PSGMI($P(ND,U,7))
- S PSJONETM=$S(QST="O":1,1:0),PSJONCAL=$S(QST="OA":1,1:0)
- S PSJSI=$$ENSET^PSGSICHK(^TMP($J,QST,PSGP,ON,1))
- NEW MARX
- D DRGDISP^PSJLMUT1(PSGP,+ON_$S(QST["Z":"P",1:"U"),40,0,.MARX,1)
- S PSJNEED=$S($D(MARX(2)):2,1:1)
- S X=$L(PSJSI)/41,X=$P(X,".")+($P(X,".",2)>0)
- S PSJNEED=PSJNEED+X+5+PSJHOLD+PSJONETM+PSJONCAL
- D ^PSJMPRTU,PRT^PSJMPRTU
- Q
- PSJMPRT ;BIR/MV-PRINT DRIVE FOR MDWS ;13 FEB 96 / 10:06 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;Loop thru TMP global to print report
- +3 ;
- INIT ;
- +1 IF '$DATA(^TMP($JOB))
- QUIT
- USE IO
- +2 NEW DRG,ND,PID,PID1,PPN,PPN1,PPNO,PRB,PRB1,PRBO,QST,TM,TM1,TMO,UD0,UD2,XNAME
- +3 SET PSJHL1="MEDICATIONS DUE WORKSHEET For: "
- +4 SET PSJHL2="Report from: "_$$ENDTC^PSGMI(PSGPLS)_" to: "_$$ENDTC^PSGMI(PSGPLF)_" "_"Report Date: "_$EXTRACT($$ENDTC^PSGMI(DT),1,8)
- +5 SET XNAME=""
- IF PSGMTYPE[1
- SET XNAME="ALL MEDS"
- +6 IF PSGMTYPE[2
- SET XNAME="NON-IV MEDs"
- +7 IF PSGMTYPE[3
- IF XNAME]""
- SET XNAME=XNAME_", "
- SET XNAME=XNAME_"IVPB"
- +8 IF PSGMTYPE[4
- IF XNAME]""
- SET XNAME=XNAME_", "
- SET XNAME=XNAME_"LVPs"
- +9 IF PSGMTYPE[5
- IF XNAME]""
- SET XNAME=XNAME_", "
- SET XNAME=XNAME_"TPNs"
- +10 IF PSGMTYPE[6
- IF XNAME]""
- SET XNAME=XNAME_", "
- SET XNAME=XNAME_"CHEMO (IV)"
- +11 SET PSJHL3="Continuous/One time Orders for: "_XNAME
- +12 SET PSJHL62="* Projected admin. times based on order's volume, flow rate, and start time."
- +13 SET (PSGPG,PSJNEED,PSJLN,PSJADTO,PSJATMEO)=0
- SET (PPNO,PRBO,TMO)=""
- +14 SET (PPN,QST,DRG,TM,PSJPRB)=""
- SET PSJTOTLN=$SELECT($EXTRACT(IOST)="C":23,1:62)
- +15 DO @PSGSS
- +16 IF PSGPG
- IF $GET(PSJASTR)
- Begin DoDot:1
- +17 SET X=$Y
- FOR X=X:1:PSJTOTLN
- WRITE !
- +18 WRITE !,PSJHL62
- SET PSJASTR=0
- End DoDot:1
- +19 QUIT
- +20 ;
- P ;***Selected by Patients.
- +1 FOR PSJADT=0:0
- SET PSJADT=$ORDER(^TMP($JOB,PSJADT))
- IF 'PSJADT
- QUIT
- FOR
- SET PPN=$ORDER(^TMP($JOB,PSJADT,PPN))
- IF PPN=""
- QUIT
- Begin DoDot:1
- +2 SET PSJHL1=$PIECE(PSJHL1,":")_": "_$PIECE(PPN,U)
- +3 FOR PSJATME=0:0
- SET PSJATME=$ORDER(^TMP($JOB,PSJADT,PPN,PSJATME))
- IF 'PSJATME
- QUIT
- FOR
- SET QST=$ORDER(^TMP($JOB,PSJADT,PPN,PSJATME,QST))
- IF QST=""
- QUIT
- Begin DoDot:2
- +4 FOR
- SET DRG=$ORDER(^TMP($JOB,PSJADT,PPN,PSJATME,QST,DRG))
- IF DRG=""
- QUIT
- IF '$GET(PSJSTOP)
- DO PRT
- End DoDot:2
- End DoDot:1
- +5 QUIT
- +6 ;
- G ;***Selected by Ward Group.
- +1 SET PSJHL1=PSJHL1_PSGWGNM
- +2 ;
- W ;***Selected by Ward.
- +1 IF PSGSS="W"
- SET PSJHL1=PSJHL1_PSGWN
- +2 FOR PSJADT=0:0
- SET PSJADT=$ORDER(^TMP($JOB,PSJADT))
- IF 'PSJADT
- QUIT
- FOR
- SET TM=$ORDER(^TMP($JOB,PSJADT,TM))
- IF TM=""
- QUIT
- DO @("W"_PSGRBADM)
- +3 QUIT
- +4 ;
- WA ;*** Selected by Ward and sort by Admin. time.
- +1 FOR PSJATME=0:0
- SET PSJATME=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME))
- IF 'PSJATME
- QUIT
- FOR
- SET PSJPRB=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB))
- IF PSJPRB=""
- QUIT
- Begin DoDot:1
- +2 FOR
- SET PPN=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB,PPN))
- IF PPN=""
- QUIT
- FOR
- SET QST=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB,PPN,QST))
- IF QST=""
- QUIT
- Begin DoDot:2
- +3 FOR
- SET DRG=$ORDER(^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG))
- IF DRG=""
- QUIT
- IF '$GET(PSJSTOP)
- DO PRT
- End DoDot:2
- End DoDot:1
- +4 QUIT
- +5 ;
- WP ;*** Selected by Ward and sort by Patients.
- +1 FOR
- SET PPN=$ORDER(^TMP($JOB,PSJADT,TM,PPN))
- IF PPN=""
- QUIT
- FOR PSJATME=0:0
- SET PSJATME=$ORDER(^TMP($JOB,PSJADT,TM,PPN,PSJATME))
- IF 'PSJATME
- QUIT
- Begin DoDot:1
- +2 FOR
- SET QST=$ORDER(^TMP($JOB,PSJADT,TM,PPN,PSJATME,QST))
- IF QST=""
- QUIT
- FOR
- SET DRG=$ORDER(^TMP($JOB,PSJADT,TM,PPN,PSJATME,QST,DRG))
- IF DRG=""
- QUIT
- Begin DoDot:2
- +3 IF '$GET(PSJSTOP)
- DO PRT
- End DoDot:2
- End DoDot:1
- +4 QUIT
- +5 ;
- WR ;*** Selected by Ward and sort by Room-Bed.
- +1 FOR
- SET PSJPRB=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB))
- IF PSJPRB=""
- QUIT
- FOR
- SET PPN=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN))
- IF PPN=""
- QUIT
- Begin DoDot:1
- +2 FOR PSJATME=0:0
- SET PSJATME=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN,PSJATME))
- IF 'PSJATME
- QUIT
- FOR
- SET QST=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN,PSJATME,QST))
- IF QST=""
- QUIT
- Begin DoDot:2
- +3 FOR
- SET DRG=$ORDER(^TMP($JOB,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG))
- IF DRG=""
- QUIT
- IF '$GET(PSJSTOP)
- DO PRT
- End DoDot:2
- End DoDot:1
- +4 QUIT
- +5 ;
- PRT ;
- +1 SET ND=^(DRG)
- SET PSGP=+ND
- SET ON=$PIECE(ND,U,2)
- SET PID=$PIECE(ND,U,3)
- SET PSGWN=$SELECT(PSGSS="W":"",1:$PIECE(ND,U,4))
- SET PRB=$PIECE(ND,U,5)
- +2 IF QST["V"
- DO PRT^PSJMIV
- QUIT
- +3 SET ND=^TMP($JOB,QST,PSGP,ON)
- SET PSJDOS=$PIECE(ND,U)
- SET PSJMR=$PIECE(ND,U,2)
- SET PSJSCHE=$PIECE(ND,U,3)
- SET PSJHOLD=$SELECT($PIECE(ND,U,4):1,1:0)
- +4 SET PSGLOD=$EXTRACT($$ENDTC^PSGMI($PIECE(ND,U,5)),1,5)
- +5 IF QST'["Z"
- SET X=$$ENDTC^PSGMI($PIECE(ND,U,6))
- SET PSGLSD=$EXTRACT(X,1,5)_$EXTRACT(X,9,15)
- SET PSGLFD=$$ENDTC^PSGMI($PIECE(ND,U,7))
- +6 SET PSJONETM=$SELECT(QST="O":1,1:0)
- SET PSJONCAL=$SELECT(QST="OA":1,1:0)
- +7 SET PSJSI=$$ENSET^PSGSICHK(^TMP($JOB,QST,PSGP,ON,1))
- +8 NEW MARX
- +9 DO DRGDISP^PSJLMUT1(PSGP,+ON_$SELECT(QST["Z":"P",1:"U"),40,0,.MARX,1)
- +10 SET PSJNEED=$SELECT($DATA(MARX(2)):2,1:1)
- +11 SET X=$LENGTH(PSJSI)/41
- SET X=$PIECE(X,".")+($PIECE(X,".",2)>0)
- +12 SET PSJNEED=PSJNEED+X+5+PSJHOLD+PSJONETM+PSJONCAL
- +13 DO ^PSJMPRTU
- DO PRT^PSJMPRTU
- +14 QUIT
