- PSJMPEND ;BIR/CML3-MD MARS - GATHER ACK ORDERS INFO (MDWS) ; 6/18/07 12:11pm
- ;;5.0; INPATIENT MEDICATIONS ;**191**;16 DEC 97;Build 9
- ;
- PEND ;*** Only select orders that were acknowledged by nurses and are
- ;*** still having pending status.
- NEW X S X=$O(^PS(59.6,"B",+PSJPWD,0)) Q:'+$P($G(^PS(59.6,+X,0)),U,6)
- NEW ND,ON,TYPE,QST
- F ON=0:0 S ON=$O(^PS(53.1,"AV",PSGP,ON)) Q:'ON D
- . S ND=$G(^PS(53.1,ON,0)),TYPE=$P(ND,U,4)
- . S ND2=$G(^PS(53.1,ON,2)),PSGLSD=$P(ND2,U,2),PSGLFD=$P(ND2,U,4)
- . I $P(ND,U,7)="P"!($P($G(^PS(53.1,ON,2)),U)["PRN") S QST="PZ"_$S($P(ND,U,4)="F":"V",1:"A")
- . E S QST="CZ"_$S($P(ND,U,4)="F":"V",1:"A")
- . I PSGMTYPE[1 D:TYPE'="F" SETTMP D:TYPE="F" IV
- . I PSGMTYPE'[1 D
- .. I PSGMTYPE[2,(TYPE="U") D SETTMP Q
- .. I PSGMTYPE'[2,(TYPE="I") D SETTMP Q
- .. I PSGMTYPE[4,(TYPE="F") D IV
- Q
- ;
- SETTMP ;*** Setup ^tmp for pending U/D and Inpatient med IVs.
- ;*** PZ_(V/A) = PRN/One time orders (V=IV).
- ;*** CZ_(V/A) = Continuous orders (A=U/D).
- I 'PSJMPRN,(QST["PZ") Q
- NEW MARX
- D DRGDISP^PSJLMUT1(PSGP,+ON_"P",20,0,.MARX,1) S DRG=MARX(1)_U_ON
- ;*** Set up ^TMP for sort by patients
- S PSJDOS=$P(^PS(53.1,ON,.2),U,2),PSJMR=$E($S($P(ND,U,3)]"":$P(ND,U,3),1:$P(ND,U)),1,5),PSJSCHE=$P($G(^PS(53.1,ON,2)),U)
- S PSJHOLD=$S($P(ND,U,9)["H":1,1:0),PSGLOD=$P(ND,U,14),PSJATME=9999,PSJADT=$S(QST["C":"8999999",1:"9999999")
- D SI
- I PSGSS="P" D Q
- . S ^TMP($J,PSJADT,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB
- . S ^TMP($J,QST,PSGP,ON)=PSJDOS_U_PSJMR_U_PSJSCHE_U_PSJHOLD_U_PSGLOD
- . S ^TMP($J,QST,PSGP,ON,1)=PSJSI
- ;*** Set up ^TMP when listing by ward
- S:PSGRBADM="A" ^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- S:PSGRBADM="R" ^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- S:PSGRBADM="P" ^TMP($J,PSJADT,TM,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- S ^TMP($J,QST,PSGP,ON)=PSJDOS_U_PSJMR_U_PSJSCHE_U_PSJHOLD_U_PSGLOD_U_PSGLSD_U_PSGLFD
- S ^TMP($J,QST,PSGP,ON,1)=PSJSI
- Q
- SI ;*** Find the Special instructions.
- S X=0,PSJSI="" F S X=$O(^PS(53.1,ON,12,X)) Q:'X S Z=$G(^(X,0)),Y=$L(PSJSI) S:Y+$L(Z)'>179 PSJSI=PSJSI_Z_" " I Y+$L(Z)>179 S PSJSI="SEE PROVIDER COMMENTS" Q
- Q
- ;
- IV ;*** Sort IV pending orders for 24 Hrs, 7/14 Day MAR.
- K DRG,P NEW X,ON55,P,PSJLABEL
- S DFN=PSGP,PSJLABEL=1 D GT531^PSIVORFA(DFN,ON)
- S X=$P(P("MR"),U,2)
- S QST=QST_4
- S PSJADT=$S(QST["C":"8999999",1:"9999999")
- I DRG S X=$S($G(DRG("AD",1)):DRG("AD",1),1:$G(DRG("SOL",1))),X=$E($P(X,U,2),1,20)_U_ON D
- . I PSGSS="P" S ^TMP($J,PSJADT,PPN_U_PSGP,"9999",QST,X)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB Q
- . S:PSGRBADM="A" ^TMP($J,PSJADT,TM,"9999",PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- . S:PSGRBADM="R" ^TMP($J,PSJADT,TM,PSJPRB,PPN,"9999",QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- . S:PSGRBADM="P" ^TMP($J,PSJADT,TM,PPN_U_PSGP,"9999",QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- Q
- PSJMPEND ;BIR/CML3-MD MARS - GATHER ACK ORDERS INFO (MDWS) ; 6/18/07 12:11pm
- +1 ;;5.0; INPATIENT MEDICATIONS ;**191**;16 DEC 97;Build 9
- +2 ;
- PEND ;*** Only select orders that were acknowledged by nurses and are
- +1 ;*** still having pending status.
- +2 NEW X
- SET X=$ORDER(^PS(59.6,"B",+PSJPWD,0))
- IF '+$PIECE($GET(^PS(59.6,+X,0)),U,6)
- QUIT
- +3 NEW ND,ON,TYPE,QST
- +4 FOR ON=0:0
- SET ON=$ORDER(^PS(53.1,"AV",PSGP,ON))
- IF 'ON
- QUIT
- Begin DoDot:1
- +5 SET ND=$GET(^PS(53.1,ON,0))
- SET TYPE=$PIECE(ND,U,4)
- +6 SET ND2=$GET(^PS(53.1,ON,2))
- SET PSGLSD=$PIECE(ND2,U,2)
- SET PSGLFD=$PIECE(ND2,U,4)
- +7 IF $PIECE(ND,U,7)="P"!($PIECE($GET(^PS(53.1,ON,2)),U)["PRN")
- SET QST="PZ"_$SELECT($PIECE(ND,U,4)="F":"V",1:"A")
- +8 IF '$TEST
- SET QST="CZ"_$SELECT($PIECE(ND,U,4)="F":"V",1:"A")
- +9 IF PSGMTYPE[1
- IF TYPE'="F"
- DO SETTMP
- IF TYPE="F"
- DO IV
- +10 IF PSGMTYPE'[1
- Begin DoDot:2
- +11 IF PSGMTYPE[2
- IF (TYPE="U")
- DO SETTMP
- QUIT
- +12 IF PSGMTYPE'[2
- IF (TYPE="I")
- DO SETTMP
- QUIT
- +13 IF PSGMTYPE[4
- IF (TYPE="F")
- DO IV
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- SETTMP ;*** Setup ^tmp for pending U/D and Inpatient med IVs.
- +1 ;*** PZ_(V/A) = PRN/One time orders (V=IV).
- +2 ;*** CZ_(V/A) = Continuous orders (A=U/D).
- +3 IF 'PSJMPRN
- IF (QST["PZ")
- QUIT
- +4 NEW MARX
- +5 DO DRGDISP^PSJLMUT1(PSGP,+ON_"P",20,0,.MARX,1)
- SET DRG=MARX(1)_U_ON
- +6 ;*** Set up ^TMP for sort by patients
- +7 SET PSJDOS=$PIECE(^PS(53.1,ON,.2),U,2)
- SET PSJMR=$EXTRACT($SELECT($PIECE(ND,U,3)]"":$PIECE(ND,U,3),1:$PIECE(ND,U)),1,5)
- SET PSJSCHE=$PIECE($GET(^PS(53.1,ON,2)),U)
- +8 SET PSJHOLD=$SELECT($PIECE(ND,U,9)["H":1,1:0)
- SET PSGLOD=$PIECE(ND,U,14)
- SET PSJATME=9999
- SET PSJADT=$SELECT(QST["C":"8999999",1:"9999999")
- +9 DO SI
- +10 IF PSGSS="P"
- Begin DoDot:1
- +11 SET ^TMP($JOB,PSJADT,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB
- +12 SET ^TMP($JOB,QST,PSGP,ON)=PSJDOS_U_PSJMR_U_PSJSCHE_U_PSJHOLD_U_PSGLOD
- +13 SET ^TMP($JOB,QST,PSGP,ON,1)=PSJSI
- End DoDot:1
- QUIT
- +14 ;*** Set up ^TMP when listing by ward
- +15 IF PSGRBADM="A"
- SET ^TMP($JOB,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- +16 IF PSGRBADM="R"
- SET ^TMP($JOB,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- +17 IF PSGRBADM="P"
- SET ^TMP($JOB,PSJADT,TM,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- +18 SET ^TMP($JOB,QST,PSGP,ON)=PSJDOS_U_PSJMR_U_PSJSCHE_U_PSJHOLD_U_PSGLOD_U_PSGLSD_U_PSGLFD
- +19 SET ^TMP($JOB,QST,PSGP,ON,1)=PSJSI
- +20 QUIT
- SI ;*** Find the Special instructions.
- +1 SET X=0
- SET PSJSI=""
- FOR
- SET X=$ORDER(^PS(53.1,ON,12,X))
- IF 'X
- QUIT
- SET Z=$GET(^(X,0))
- SET Y=$LENGTH(PSJSI)
- IF Y+$LENGTH(Z)'>179
- SET PSJSI=PSJSI_Z_" "
- IF Y+$LENGTH(Z)>179
- SET PSJSI="SEE PROVIDER COMMENTS"
- QUIT
- +2 QUIT
- +3 ;
- IV ;*** Sort IV pending orders for 24 Hrs, 7/14 Day MAR.
- +1 KILL DRG,P
- NEW X,ON55,P,PSJLABEL
- +2 SET DFN=PSGP
- SET PSJLABEL=1
- DO GT531^PSIVORFA(DFN,ON)
- +3 SET X=$PIECE(P("MR"),U,2)
- +4 SET QST=QST_4
- +5 SET PSJADT=$SELECT(QST["C":"8999999",1:"9999999")
- +6 IF DRG
- SET X=$SELECT($GET(DRG("AD",1)):DRG("AD",1),1:$GET(DRG("SOL",1)))
- SET X=$EXTRACT($PIECE(X,U,2),1,20)_U_ON
- Begin DoDot:1
- +7 IF PSGSS="P"
- SET ^TMP($JOB,PSJADT,PPN_U_PSGP,"9999",QST,X)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB
- QUIT
- +8 IF PSGRBADM="A"
- SET ^TMP($JOB,PSJADT,TM,"9999",PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- +9 IF PSGRBADM="R"
- SET ^TMP($JOB,PSJADT,TM,PSJPRB,PPN,"9999",QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- +10 IF PSGRBADM="P"
- SET ^TMP($JOB,PSJADT,TM,PPN_U_PSGP,"9999",QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
- End DoDot:1
- +11 QUIT
