| 1 | PSJMPEND ;BIR/CML3-MD MARS - GATHER ACK ORDERS INFO (MDWS) ;20 DEC 96 / 3:15 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | PEND ;*** Only select orders that were acknowledged by nurses and are
|
|---|
| 5 | ;*** still having pending status.
|
|---|
| 6 | NEW X S X=$O(^PS(59.6,"B",+PSJPWD,0)) Q:'+$P($G(^PS(59.6,+X,0)),U,6)
|
|---|
| 7 | NEW ND,ON,TYPE,QST
|
|---|
| 8 | F ON=0:0 S ON=$O(^PS(53.1,"AV",PSGP,ON)) Q:'ON D
|
|---|
| 9 | . S ND=$G(^PS(53.1,ON,0)),TYPE=$P(ND,U,4)
|
|---|
| 10 | . 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")
|
|---|
| 11 | . E S QST="CZ"_$S($P(ND,U,4)="F":"V",1:"A")
|
|---|
| 12 | . I PSGMTYPE[1 D:TYPE'="F" SETTMP D:TYPE="F" IV
|
|---|
| 13 | . I PSGMTYPE'[1 D
|
|---|
| 14 | .. I PSGMTYPE[2,(TYPE="U") D SETTMP Q
|
|---|
| 15 | .. I PSGMTYPE'[2,(TYPE="I") D SETTMP Q
|
|---|
| 16 | .. I PSGMTYPE[4,(TYPE="F") D IV
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | SETTMP ;*** Setup ^tmp for pending U/D and Inpatient med IVs.
|
|---|
| 20 | ;*** PZ_(V/A) = PRN/One time orders (V=IV).
|
|---|
| 21 | ;*** CZ_(V/A) = Continuous orders (A=U/D).
|
|---|
| 22 | I 'PSJMPRN,(QST["PZ") Q
|
|---|
| 23 | NEW MARX
|
|---|
| 24 | D DRGDISP^PSJLMUT1(PSGP,+ON_"P",20,0,.MARX,1) S DRG=MARX(1)_U_ON
|
|---|
| 25 | ;*** Set up ^TMP for sort by patients
|
|---|
| 26 | 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),PSJSCH=$P($G(^PS(53.1,ON,2)),U)
|
|---|
| 27 | 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")
|
|---|
| 28 | D SI
|
|---|
| 29 | I PSGSS="P" D Q
|
|---|
| 30 | . S ^TMP($J,PSJADT,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB
|
|---|
| 31 | . S ^TMP($J,QST,PSGP,ON)=PSJDOS_U_PSJMR_U_PSJSCHE_U_PSJHOLD_U_PSGLOD
|
|---|
| 32 | . S ^TMP($J,QST,PSGP,ON,1)=PSJSI
|
|---|
| 33 | ;*** Set up ^TMP when listing by ward
|
|---|
| 34 | S:PSGRBADM="A" ^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
|
|---|
| 35 | S:PSGRBADM="R" ^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
|
|---|
| 36 | S:PSGRBADM="P" ^TMP($J,PSJADT,TM,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
|
|---|
| 37 | S ^TMP($J,QST,PSGP,ON)=PSJDOS_U_PSJMR_U_PSJSCHE_U_PSJHOLD_U_PSGLOD_U_PSGLSD_U_PSGLFD
|
|---|
| 38 | S ^TMP($J,QST,PSGP,ON,1)=PSJSI
|
|---|
| 39 | Q
|
|---|
| 40 | SI ;*** Find the Special instructions.
|
|---|
| 41 | 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
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | IV ;*** Sort IV pending orders for 24 Hrs, 7/14 Day MAR.
|
|---|
| 45 | K DRG,P NEW X,ON55,P,PSJLABEL
|
|---|
| 46 | S DFN=PSGP,PSJLABEL=1 D GT531^PSIVORFA(DFN,ON)
|
|---|
| 47 | S X=$P(P("MR"),U,2)
|
|---|
| 48 | S QST=QST_4
|
|---|
| 49 | S PSJADT=$S(QST["C":"8999999",1:"9999999")
|
|---|
| 50 | 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
|
|---|
| 51 | . I PSGSS="P" S ^TMP($J,PSJADT,PPN_U_PSGP,"9999",QST,X)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB Q
|
|---|
| 52 | . S:PSGRBADM="A" ^TMP($J,PSJADT,TM,"9999",PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
|
|---|
| 53 | . S:PSGRBADM="R" ^TMP($J,PSJADT,TM,PSJPRB,PPN,"9999",QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
|
|---|
| 54 | . S:PSGRBADM="P" ^TMP($J,PSJADT,TM,PPN_U_PSGP,"9999",QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
|
|---|
| 55 | Q
|
|---|
