- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL5.m
r613 r623 1 PSJHL5 ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR ;28 Jan 98 / 3:34 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**1,28,39,40,42,84,85,95,80,173,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(55 is supported by DBIA# 2191. 5 ; Reference to EN^ORERR is supported by DBIA# 2187. 6 ; Reference to NURV^ALPBCBU is supported by DBIA# 4120. 7 ; Reference to UNESC^ORHLESC is supported by DBIA# 4922 8 ; 9 ASSIGN ; number assigned, update ORDERS FILE ENTRY 10 S RXORDER=RXORDER_"0)" 11 I '$P($G(@RXORDER),U) S ORDCON="Invalid Pharmacy order number/Number Assign Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 12 Q:'$P($G(@RXORDER),U) 13 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER)),U,15) S ORDCON="Patient does not match/Number Assign Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 14 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER)),U,15) Q 15 S $P(@RXORDER,"^",21)=PSJORDER 16 Q 17 ; 18 NURSEACK ;Nurse Acknowledgement of Pending Orders 19 I '$P($G(@(RXORDER_"0)")),U) S ORDCON="Invalid Pharmacy order number/Nurse Acknowledgement Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 20 Q:'$P($G(@(RXORDER_"0)")),U) 21 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER_"0)")),U,15) S ORDCON="Patient does not match/Nurse Acknowledgement Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 22 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER_"0)")),U,15) Q 23 I RXON["P" N STATUS S STATUS=$P($G(@(RXORDER_"0)")),U,9) D:STATUS="N" EN^PSJHLV(PSJHLDFN,RXON) 24 I RXON["P" N STATUS S STATUS=$P($G(@(RXORDER_"0)")),U,9) Q:STATUS="A" 25 N DIE,DA 26 S DIE=$S(RXON["N"!(RXON["P"):"^PS(53.1,",RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+RXON,DA(1)=PSJHLDFN 27 S DR="16////"_NURSEACK_";17////"_ACKDATE S:RXON["U" DR=DR_";51////1" S:RXON["V" DR=DR_";143////1",PSIVACT="" 28 I RXON["U" D NEWUDAL^PSGAL5(PSJHLDFN,RXON,22010) 29 I RXON["P" D NEWNVAL^PSGAL5(RXON,22010) 30 S PSGNVF=1 D ^DIE 31 I RXON["V" NEW ON55,DFN,PSIVAL,PSIVREA,PSIVLN K PSIVACT D 32 . S ON55=RXON,DFN=PSJHLDFN,PSIVAL="ORDER VERIFIED BY NURSE",PSIVALT="",PSIVREA="V" 33 . D LOG^PSIVORAL 34 D:RXON["P" EN^PSJLOI(PSJHLDFN,RXON) D:RXON["U" EN2^PSJLOI(PSJHLDFN,RXON) 35 K:RXON["U" ^PS(55,"ANV",PSJHLDFN,+RXON) 36 I $T(NURV^ALPBCBU)'="" D NURV^ALPBCBU(PSJHLDFN,RXON) 37 Q 38 ; 39 EDIT ;Edit orders thru OE/RR 40 N DA,DR,DIE,PREORDER,STPDT,PSIVACT,PSIVALT,ON55,PSIVREA,PSIVALCK,P 41 S PREORDER=$S((PREON["N")!(PREON["P"):"^PS(53.1,"_+PREON_",2)",PREON["V":"^PS(55,"_PSJHLDFN_",""IV"","_+PREON_",0)",1:"^PS(55,"_PSJHLDFN_",5,"_+PREON_",2)") 42 S STPDT=$S(PREON["V":$P($G(@PREORDER),"^",3),1:$P($G(@PREORDER),"^",4)) 43 D NOW^%DTC 44 S DIE=$S(PREON["N"!(PREON["P"):"^PS(53.1,",PREON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+PREON,DA(1)=+PSJHLDFN 45 S DR=$S(PREON["V":"100////D;116////^S X=STPDT;123////E;114////"_PSJORDER_";.03////"_%,((PREON["P")!(PREON["N")):"25////"_%_";28////DE;107////E;105////"_PSJORDER_";32////"_STPDT,1:"25////"_STPDT_";28////DE;107////E;105////"_PSJORDER_";34////"_%) 46 I PREON["U"!(PREON["A") S PSGAL("C")=4100 D ^PSGAL5 47 I PREON["V" S PSIVACT=1,PSIVALT=2,ON55=PREON,PSIVREA="D",PSIVALCK="STOP",P(3)=STPDT 48 D ^DIE,AUE^PSJHL6(PSJHLDFN,PREON) 49 I PREON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL 50 S PSJHLMTN="ORM",PSOC=$S((PREON["N")!(PREON["P"):"OC",1:"OD") D EN1^PSJHL2(PSJHLDFN,PSOC,PREON) S PSJHLMTN="ORR",PSOC="XO" 51 Q 52 ; 53 EDITCK ;Check to see if PSJHLDFN passed matches PSJHLDFN in pending order. 54 I (PREON["N")!(PREON["P"),PSJHLDFN'=$P($G(^PS(53.1,+PREON,0)),U,15) D 55 . S ORDCON="Patient does not match/Edit Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) 56 . D EN1^PSJHLERR(PSJHLDFN,"UX",$P(ORDER,"^"),ORDCON) S QFLG=1 57 Q 58 ; 59 STATUS ;Check status of an order in response to a send order status request from CPRS. 60 N STATUS,STPDT,NODE,NODE2 61 S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)")) 62 I 'NODE S PSREASON="Invalid Pharmacy order number" D Q 63 .S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(PSREASON_"/Status Check",.PSJMSG) 64 .D EN1^PSJHLERR(PSJHLDFN,"DE",$P(ORDER,U),PSREASON) 65 S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^") 66 S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9)) 67 S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4)) 68 D NOW^%DTC I RXON'["P" I "DEH"'[STATUS I STPDT<% D EXPIR^PSJHL6 Q 69 D EN1^PSJHL2(PSJHLDFN,"SC",RXON) 70 Q 71 ; 72 FLAG ;Flag/Unflag orders 73 I '$P($G(@(RXORDER_"0)")),U) S ORDCON="Invalid Pharmacy order number/Flag Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 74 Q:'$P($G(@(RXORDER_"0)")),U) 75 S DIE=$S(RXON["N"!(RXON["P"):"^PS(53.1,",RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+RXON,DA(1)=PSJHLDFN 76 S DR=$S(PSJFLAG="FL":$S(RXON["V":"148////1",1:"124////1"),1:$S(RXON["V":"148////@",1:"124////@")) 77 D ^DIE 78 I $G(FLCMNT)]"" S FLCMNT=$$UNESC^ORHLESC(FLCMNT) 79 I RXON["U" D 80 . S ^PS(55,PSJHLDFN,5,+RXON,13)=FLCMNT 81 . S FLCMNT="COMMENTS: "_FLCMNT S:$L(FLCMNT)>52 FLCMNT=$E(FLCMNT,1,49)_"..." 82 . D NEWUDAL^PSGAL5(PSJHLDFN,+RXON,$S((PSJFLAG="FL")&(PSJYN="PHR"):7000,(PSJFLAG="UF")&(PSJYN="PHR"):7010,(PSJFLAG="FL")&(PSJYN=""):7020,1:7030),FLCMNT) 83 I RXON["V" N DFN,ON55,PSIVREA,PSIVAL S DFN=PSJHLDFN S PSIVALT="",ON55=RXON,PSIVREA=$S(PSJFLAG="FL":"G",1:"UG"),PSIVAL=$S(PSJYN="PHR":"FLAGGED BY PHARMACIST ",1:"FLAGGED BY CPRS ")_FLCMNT D LOG^PSIVORAL 84 I RXON["P" D 85 . S ^PS(53.1,+RXON,13)=FLCMNT 86 . S FLCMNT="COMMENTS: "_FLCMNT S:$L(FLCMNT)>52 FLCMNT=$E(FLCMNT,1,49)_"..." 87 . D NEWNVAL^PSGAL5(+RXON,$S((PSJFLAG="FL")&(PSJYN="PHR"):7000,(PSJFLAG="UF")&(PSJYN="PHR"):7010,(PSJFLAG="FL")&(PSJYN=""):7020,1:7030),FLCMNT) 88 ;The ... on Unit Dose and Pending orders is because of the limitations in the DD of 53.1. 89 Q 1 PSJHL5 ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR ;28 Jan 98 / 3:34 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**1,28,39,40,42,84,85,95,80,173**;16 DEC 97;Build 4 3 ; 4 ; Reference to ^PS(55 is supported by DBIA# 2191. 5 ; Reference to EN^ORERR is supported by DBIA# 2187. 6 ; Reference to NURV^ALPBCBU is supported by DBIA# 4120. 7 ; 8 ASSIGN ; number assigned, update ORDERS FILE ENTRY 9 S RXORDER=RXORDER_"0)" 10 I '$P($G(@RXORDER),U) S ORDCON="Invalid Pharmacy order number/Number Assign Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 11 Q:'$P($G(@RXORDER),U) 12 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER)),U,15) S ORDCON="Patient does not match/Number Assign Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 13 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER)),U,15) Q 14 S $P(@RXORDER,"^",21)=PSJORDER 15 Q 16 ; 17 NURSEACK ;Nurse Acknowledgement of Pending Orders 18 I '$P($G(@(RXORDER_"0)")),U) S ORDCON="Invalid Pharmacy order number/Nurse Acknowledgement Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 19 Q:'$P($G(@(RXORDER_"0)")),U) 20 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER_"0)")),U,15) S ORDCON="Patient does not match/Nurse Acknowledgement Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 21 I RXON["P",PSJHLDFN'=$P($G(@(RXORDER_"0)")),U,15) Q 22 I RXON["P" N STATUS S STATUS=$P($G(@(RXORDER_"0)")),U,9) D:STATUS="N" EN^PSJHLV(PSJHLDFN,RXON) 23 I RXON["P" N STATUS S STATUS=$P($G(@(RXORDER_"0)")),U,9) Q:STATUS="A" 24 N DIE,DA 25 S DIE=$S(RXON["N"!(RXON["P"):"^PS(53.1,",RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+RXON,DA(1)=PSJHLDFN 26 S DR="16////"_NURSEACK_";17////"_ACKDATE S:RXON["U" DR=DR_";51////1" S:RXON["V" DR=DR_";143////1",PSIVACT="" 27 I RXON["U" D NEWUDAL^PSGAL5(PSJHLDFN,RXON,22010) 28 I RXON["P" D NEWNVAL^PSGAL5(RXON,22010) 29 S PSGNVF=1 D ^DIE 30 I RXON["V" NEW ON55,DFN,PSIVAL,PSIVREA,PSIVLN K PSIVACT D 31 . S ON55=RXON,DFN=PSJHLDFN,PSIVAL="ORDER VERIFIED BY NURSE",PSIVALT="",PSIVREA="V" 32 . D LOG^PSIVORAL 33 D:RXON["P" EN^PSJLOI(PSJHLDFN,RXON) D:RXON["U" EN2^PSJLOI(PSJHLDFN,RXON) 34 K:RXON["U" ^PS(55,"ANV",PSJHLDFN,+RXON) 35 I $T(NURV^ALPBCBU)'="" D NURV^ALPBCBU(PSJHLDFN,RXON) 36 Q 37 ; 38 EDIT ;Edit orders thru OE/RR 39 N DA,DR,DIE,PREORDER,STPDT,PSIVACT,PSIVALT,ON55,PSIVREA,PSIVALCK,P 40 S PREORDER=$S((PREON["N")!(PREON["P"):"^PS(53.1,"_+PREON_",2)",PREON["V":"^PS(55,"_PSJHLDFN_",""IV"","_+PREON_",0)",1:"^PS(55,"_PSJHLDFN_",5,"_+PREON_",2)") 41 S STPDT=$S(PREON["V":$P($G(@PREORDER),"^",3),1:$P($G(@PREORDER),"^",4)) 42 D NOW^%DTC 43 S DIE=$S(PREON["N"!(PREON["P"):"^PS(53.1,",PREON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+PREON,DA(1)=+PSJHLDFN 44 S DR=$S(PREON["V":"100////D;116////^S X=STPDT;123////E;114////"_PSJORDER_";.03////"_%,((PREON["P")!(PREON["N")):"25////"_%_";28////DE;107////E;105////"_PSJORDER_";32////"_STPDT,1:"25////"_STPDT_";28////DE;107////E;105////"_PSJORDER_";34////"_%) 45 I PREON["U"!(PREON["A") S PSGAL("C")=4100 D ^PSGAL5 46 I PREON["V" S PSIVACT=1,PSIVALT=2,ON55=PREON,PSIVREA="D",PSIVALCK="STOP",P(3)=STPDT 47 D ^DIE,AUE^PSJHL6(PSJHLDFN,PREON) 48 I PREON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL 49 S PSJHLMTN="ORM",PSOC=$S((PREON["N")!(PREON["P"):"OC",1:"OD") D EN1^PSJHL2(PSJHLDFN,PSOC,PREON) S PSJHLMTN="ORR",PSOC="XO" 50 Q 51 ; 52 EDITCK ;Check to see if PSJHLDFN passed matches PSJHLDFN in pending order. 53 I (PREON["N")!(PREON["P"),PSJHLDFN'=$P($G(^PS(53.1,+PREON,0)),U,15) D 54 . S ORDCON="Patient does not match/Edit Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) 55 . D EN1^PSJHLERR(PSJHLDFN,"UX",$P(ORDER,"^"),ORDCON) S QFLG=1 56 Q 57 ; 58 STATUS ;Check status of an order in response to a send order status request from CPRS. 59 N STATUS,STPDT,NODE,NODE2 60 S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)")) 61 I 'NODE S PSREASON="Invalid Pharmacy order number" D Q 62 .S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(PSREASON_"/Status Check",.PSJMSG) 63 .D EN1^PSJHLERR(PSJHLDFN,"DE",$P(ORDER,U),PSREASON) 64 S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^") 65 S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9)) 66 S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4)) 67 D NOW^%DTC I RXON'["P" I "DEH"'[STATUS I STPDT<% D EXPIR^PSJHL6 Q 68 D EN1^PSJHL2(PSJHLDFN,"SC",RXON) 69 Q 70 ; 71 FLAG ;Flag/Unflag orders 72 I '$P($G(@(RXORDER_"0)")),U) S ORDCON="Invalid Pharmacy order number/Flag Msg" S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG) Q 73 Q:'$P($G(@(RXORDER_"0)")),U) 74 S DIE=$S(RXON["N"!(RXON["P"):"^PS(53.1,",RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+RXON,DA(1)=PSJHLDFN 75 S DR=$S(PSJFLAG="FL":$S(RXON["V":"148////1",1:"124////1"),1:$S(RXON["V":"148////@",1:"124////@")) 76 D ^DIE 77 I RXON["U" D 78 . S ^PS(55,PSJHLDFN,5,+RXON,13)=FLCMNT 79 . S FLCMNT="COMMENTS: "_FLCMNT S:$L(FLCMNT)>52 FLCMNT=$E(FLCMNT,1,49)_"..." 80 . D NEWUDAL^PSGAL5(PSJHLDFN,+RXON,$S((PSJFLAG="FL")&(PSJYN="PHR"):7000,(PSJFLAG="UF")&(PSJYN="PHR"):7010,(PSJFLAG="FL")&(PSJYN=""):7020,1:7030),FLCMNT) 81 I RXON["V" N DFN,ON55,PSIVREA,PSIVAL S DFN=PSJHLDFN S PSIVALT="",ON55=RXON,PSIVREA=$S(PSJFLAG="FL":"G",1:"UG"),PSIVAL=$S(PSJYN="PHR":"FLAGGED BY PHARMICIST ",1:"FLAGGED BY CPRS ")_FLCMNT D LOG^PSIVORAL 82 I RXON["P" D 83 . S ^PS(53.1,+RXON,13)=FLCMNT 84 . S FLCMNT="COMMENTS: "_FLCMNT S:$L(FLCMNT)>52 FLCMNT=$E(FLCMNT,1,49)_"..." 85 . D NEWNVAL^PSGAL5(+RXON,$S((PSJFLAG="FL")&(PSJYN="PHR"):7000,(PSJFLAG="UF")&(PSJYN="PHR"):7010,(PSJFLAG="FL")&(PSJYN=""):7020,1:7030),FLCMNT) 86 ;The ... on Unit Dose and Pending orders is because of the limitations in the DD of 53.1. 87 Q
Note:
See TracChangeset
for help on using the changeset viewer.
