- 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/PSJLIACT.m
r613 r623 1 PSJLIACT ;BIR/MV-IV ACTION ;28 Jul 98 / 8:50 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**15,47,62,58,82,97,80,110,111,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(55 is supported by DBIA 2191. 5 ; Reference to MAIN^TIUEDIT is supported by DBIA 2410. 6 ; 7 DC ; Discontinue order 8 D HOLDHDR^PSJOE 9 S PSJCOM=+$S(PSJORD["V":$P($G(^PS(55,DFN,"IV",+PSJORD,.2)),"^",8),1:$P($G(^PS(53.1,+PSJORD,.2)),"^",8)) 10 I PSJCOM W !!,"This order is part of a complex order. If you discontinue this order the",!,"following orders will be discontinued too (unless the stop date has already",!,"been reached)." D CMPLX^PSJCOM1(PSGP,PSJCOM,PSJORD) 11 I PSJCOM F W !!,"Do you want to discontinue this order" S %=1 D YN^DICN Q:% D ENCOM^PSGOEM 12 I PSJCOM,%'=1 S VALMBK="" Q 13 I PSJORD["V" D DC^PSIVORA,EN^PSJLIORD(DFN,ON) Q 14 D:PSJORD["P" DISCONT^PSIVORC 15 S VALMBCK="Q" 16 Q 17 ACEDIT ; Display LM screen and AC and EDit actions 18 D EN^PSJLIVMD 19 S VALMBCK=$S($G(PSIVACEP):"Q",1:"R") 20 Q 21 AEEXIT ; Call for EXIT CODE in PSJ LM IV AC/EDIT 22 D:ON["V" GT55^PSIVORFB 23 I ON["P" D GT531^PSIVORFA(DFN,ON) D:P("OT")'="I" GTDATA^PSJLIFN 24 D EN^PSJLIVMD 25 K PSIVENO 26 Q 27 EDIT ; Edit order 28 K PSIVFN1 NEW PSIVNBD 29 I $D(PSGACT),PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q 30 D EDIT1 31 Q:$D(PSIVNBD)!($G(PSIVCOPY)&'$G(PSIVENO)) 32 D EN^PSJLIVMD 33 S VALMBCK=$S($G(PSIVFN1):"Q",1:"R") 34 Q 35 EDIT1 ; 36 ;Ensure P() is defined 37 I $D(P)<10 S XQORQUIT=1,P("PON")="",PSIVNBD=1 D Q 38 .W !,"WARNING: An error has occurred. Changes will not be saved" 39 .D PAUSE^VALM1 40 .S VALMBCK="Q" 41 I "ANP"'[P(17) W !,"You cannot edit an inactive order" D PAUSE^VALM1 Q 42 S:$G(ON55)="" ON55=$G(PSJORD) 43 D HOLDHDR^PSJOE 44 ;* Edit a new back door order 45 I ($G(ON55)["V"&($G(P("21FLG"))="")) D Q 46 . D GSTRING^PSIVORE1,GTFLDS^PSIVORFE 47 . I $G(ON55)["V",'$G(DONE) D OK^PSIVORE 48 . S VALMBCK="Q",PSIVNBD=1 49 ;* Edit an active order 50 I $G(ON55)["V" NEW PSJEDIT1 D E^PSIVOPT1 D Q 51 . I $G(PSJIVBD) K PSJIVBD D EN^PSJLIORD(DFN,ON) 52 I $G(ON55)["P" D EDIT^PSIVORC ;Edit incomplete order. 53 K P("OVRIDE") 54 Q 55 ACCEPT ; Accept order 56 D HOLDHDR^PSJOE 57 ;Accept IV from back door. 58 I $G(PSJIVBD) K PSJIVBD D OK^PSIVORE S VALMBCK="Q" Q 59 I ON["V" D ACCEPT^PSIVOPT1 Q 60 S PSIVFN1=1 61 D COMPLTE^PSIVORC1 62 S VALMBCK="Q" 63 Q 64 R ; Renewal 65 S PSJREN=1 66 D HOLDHDR^PSJOE 67 NEW PSIVAC S PSIVAC="PR" K PSGFDX 68 D R^PSIVOPT 69 D EN^PSJLIORD(DFN,ON) 70 K PSJREN 71 Q 72 H ; Hold 73 NEW TEX S TEX="Active order ***" 74 D HOLDHDR^PSJOE 75 D H^PSIVOPT(DFN,ON,P(17),P(3)) 76 D:P(17)="A" PAUSE^VALM1 77 D EN^PSJLIORD(DFN,ON) 78 Q 79 L ; Activity Log 80 NEW PSIVLAB,PSIVLOG,PSJHIS S (PSIVLAB,PSIVLOG)=1 81 D EN^PSIVVW1 82 D EN^PSJLIVMD 83 S VALMBCK="R" 84 Q 85 O ; On Call 86 NEW TEX S TEX="Active order ***" 87 D HOLDHDR^PSJOE 88 D O^PSIVOPT(DFN,ON,P(17),P(3)) 89 D:P(17)="A" PAUSE^VALM1 90 D EN^PSJLIORD(DFN,ON) 91 Q 92 VF ; Make the order active 93 NEW PSIVCHG S PSIVCHG=0 94 I ON["V" S ON55=ON D VF1("V","ORDER VERIFIED BY ",1) Q 95 D ACTIVE^PSIVORC2 96 Q 97 VF1(PSIVREA,PSIVAL,PSIVLOG) ; 98 ;Update 4 node and set activity log. 99 ;PSIVREA: the reason use by LOG^PSIVORAL 100 ;PSIVAL : the description reason 101 ;PSIVLOG: Log an activity if = 1 102 I '+$G(OD)!($L($G(OD))>16) K OD 103 D:+PSJSYSU=3 ^PSIVORE1 104 NEW DIE,DA,DR,PSJX,XX,PSIVACT,PSJRQND 105 S PSIVACT=1 106 S PSJX=$G(^PS(55,DFN,"IV",+ON55,4)),XX="" 107 I $P(PSJX,U)="" S XX=";143////0" 108 I $P(PSJX,U,4)="" S XX=XX_U_";142////0" 109 D NOW^%DTC 110 S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN 111 I +PSJSYSU=3 S DR="140////"_DUZ_";141////"_$E(%,1,12)_";142////1"_$P(XX,U) 112 I +PSJSYSU=1 S DR="16////"_DUZ_";17////"_$E(%,1,12)_";143////1"_$P(XX,U,2) 113 I $G(P("PRY"))="D" S DR=DR_";.22////"_+P("IVRM") 114 D ^DIE 115 ; If pending IV renew is edited during finish, go back and DE the original active order left in RENEWED status 116 S PREREN=$S(ON55["V":$G(@(DIE_"+ON55,2)")),1:""),PREREN=$P(PREREN,"^",5) I PREREN D K PREREN 117 . I PREREN["P" S PREREN=$G(@("^PS(53.1,+PREREN,0)")),PREREN=$P(PREREN,"^",25) 118 . I PREREN["V" N PRERENOD S PRERENOD=$G(@("^PS(55,DFN,""IV"",+PREREN,0)")) I $P(PRERENOD,"^",17)="R",($G(P("RES"))="E") D 119 .. S DIE="^PS(55,"_DFN_",""IV"",",DA=+PREREN,DA(1)=DFN 120 .. S DR="100////D;.03////"_PSGDT S ORIGSTOP=$P($G(@("^PS(55,DFN,""IV"",+PREREN,2)")),"^",3) I ORIGSTOP S DR=DR_";116////"_ORIGSTOP 121 .. D ^DIE D EN1^PSJHL2(DFN,"SC",PREREN) 122 K DR,DIE,DA 123 I (+PSJSYSU=3)&($G(P("PRY"))="D") D 124 .N DIR W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Do you want to enter a Progress Note",DIR("B")="No" D ^DIR 125 .Q:Y="N" 126 .D MAIN^TIUEDIT(3,.TIUDA,DFN,"","","","",1) 127 Q:'$G(PSIVLOG) 128 I $G(P("PACT"))]"",+$P(P("PACT"),U,2),+$P(P("PACT"),U,3) D 129 . NEW DIC,DA,X,Y,XX,DO D NAME^PSJBCMA1($P(P("PACT"),U,2),.XX) 130 . S DIC(0)="L",DA(1)=DFN,DA(2)=+ON55,X=1 131 . S DIC="^PS(55,"_DA(1)_",""IV"","_DA(2)_",""A""," 132 . S DIC("DR")=".02////F;.03////"_XX_";.04////"_$P($G(^PS(53.3,+$P(P("PACT"),U,3),0)),U)_";.05////"_$P(P("PACT"),U)_";.06////"_$P(P("PACT"),U,2) 133 . D FILE^DICN 134 NEW PSIVALCK 135 S PSIVREA="V",PSIVALT="" 136 S PSIVAL=PSIVAL_$S(+PSJSYSU=3:"PHARMACIST",1:"NURSE") 137 D LOG^PSIVORAL K PSIVAL,PSIVREA,PSIVLN 138 I $G(PSJORD)["P" S PSIVREA="V",PSIVALT="",PSGRDTX=$G(^PS(53.1,+PSJORD,2.5)) D 139 . I $G(PSGRDTX) S PSIVAL="Requested Start Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U))) D LOG^PSIVORAL 140 . I $P(PSGRDTX,U,3) S PSIVREA="V",PSIVALT="" S PSIVAL="Requested Stop Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U,3))) D LOG^PSIVORAL 141 N DUR I $G(PSJORD) S DUR=$$GETDUR^PSJLIVMD(DFN,+PSJORD,$S(PSJORD["P":"P",1:"IV"),1) I DUR]"" D 142 . K DR S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN 143 . S DR=$S($G(IVLIMIT):"152////"_DUR,1:"151////"_DUR) K IVLIMIT 144 . D ^DIE 145 D EN1^PSJHL2(DFN,"SC",ON55) 146 D:+PSJSYSU=1 EN1^PSJHL2(DFN,"ZV",ON55) 147 D GT55^PSIVORFB S OLDON=$P($G(^PS(55,DFN,"IV",+ON55,2)),"^",5),P("OLDON")=OLDON 148 N PSJPRIO,PSJSCH,NODE0,NODEP2 S NODE0=$G(^PS(55,DFN,"IV",+ON55,0)),NODEP2=$G(^PS(55,DFN,"IV",+ON55,.2)) 149 S PSJPRIO=$P(NODEP2,"^",4),PSJSCH=$P(NODE0,"^",9) 150 I (",S,A,")[(","_$G(PSJPRIO)_",")!($G(PSJSCH)="NOW")!($G(PSJSCH)["STAT") D NOTIFY^PSJHL4(ON55,DFN,$G(PSJPRIO),$G(PSJSCH)) 151 Q 1 PSJLIACT ;BIR/MV-IV ACTION ;28 Jul 98 / 8:50 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**15,47,62,58,82,97,80,110,111**;16 DEC 97 3 ; 4 ; Reference to ^PS(55 is supported by DBIA 2191. 5 ; Reference to MAIN^TIUEDIT is supported by DBIA 2410. 6 ; 7 DC ; Discontinue order 8 D HOLDHDR^PSJOE 9 S PSJCOM=+$S(PSJORD["V":$P($G(^PS(55,DFN,"IV",+PSJORD,.2)),"^",8),1:$P($G(^PS(53.1,+PSJORD,.2)),"^",8)) 10 I PSJCOM W !!,"This order is part of a complex order. If you discontinue this order the",!,"following orders will be discontinued too (unless the stop date has already",!,"been reached)." D CMPLX^PSJCOM1(PSGP,PSJCOM,PSJORD) 11 I PSJCOM F W !!,"Do you want to discontinue this order" S %=1 D YN^DICN Q:% D ENCOM^PSGOEM 12 I PSJCOM,%'=1 S VALMBK="" Q 13 I PSJORD["V" D DC^PSIVORA,EN^PSJLIORD(DFN,ON) Q 14 D:PSJORD["P" DISCONT^PSIVORC 15 S VALMBCK="Q" 16 Q 17 ACEDIT ; Display LM screen and AC and EDit actions 18 ;K PSIVFN1 ; if not set display the second screen when finish. 19 D EN^PSJLIVMD 20 S VALMBCK=$S($G(PSIVACEP):"Q",1:"R") 21 Q 22 AEEXIT ; Call for EXIT CODE in PSJ LM IV AC/EDIT 23 D:ON["V" GT55^PSIVORFB 24 I ON["P" D GT531^PSIVORFA(DFN,ON) D:P("OT")'="I" GTDATA^PSJLIFN 25 D EN^PSJLIVMD 26 K PSIVENO 27 Q 28 EDIT ; Edit order 29 K PSIVFN1 NEW PSIVNBD 30 I $D(PSGACT),PSGACT'["E" W !,"This order may not be edited." D PAUSE^VALM1 Q 31 D EDIT1 32 ;Q:$D(PSIVNBD) 33 Q:$D(PSIVNBD)!($G(PSIVCOPY)&'$G(PSIVENO)) 34 D EN^PSJLIVMD 35 S VALMBCK=$S($G(PSIVFN1):"Q",1:"R") 36 Q 37 EDIT1 ; 38 ;Ensure P() is defined 39 I $D(P)<10 S XQORQUIT=1,P("PON")="",PSIVNBD=1 D Q 40 .W !,"WARNING: An error has occurred. Changes will not be saved" 41 .D PAUSE^VALM1 42 .S VALMBCK="Q" 43 I "ANP"'[P(17) W !,"You cannot edit an inactive order" D PAUSE^VALM1 Q 44 S:$G(ON55)="" ON55=$G(PSJORD) 45 D HOLDHDR^PSJOE 46 ;* Edit a new back door order 47 ;;I ($G(ON55)["V"&($G(P(21))="")) D Q 48 I ($G(ON55)["V"&($G(P("21FLG"))="")) D Q 49 . D GSTRING^PSIVORE1,GTFLDS^PSIVORFE 50 . I $G(ON55)["V",'$G(DONE) D OK^PSIVORE 51 . S VALMBCK="Q",PSIVNBD=1 52 ;* Edit an active order 53 I $G(ON55)["V" NEW PSJEDIT1 D E^PSIVOPT1 D Q 54 . I $G(PSJIVBD) K PSJIVBD D EN^PSJLIORD(DFN,ON) 55 I $G(ON55)["P" D EDIT^PSIVORC ;Edit incomplete order. 56 Q 57 ACCEPT ; Accept order 58 D HOLDHDR^PSJOE 59 ;Accept IV from back door. 60 I $G(PSJIVBD) K PSJIVBD D OK^PSIVORE S VALMBCK="Q" Q 61 I ON["V" D ACCEPT^PSIVOPT1 Q 62 S PSIVFN1=1 63 D COMPLTE^PSIVORC1 64 S VALMBCK="Q" 65 Q 66 R ; Renewal 67 S PSJREN=1 68 D HOLDHDR^PSJOE 69 NEW PSIVAC S PSIVAC="PR" K PSGFDX 70 D R^PSIVOPT 71 D EN^PSJLIORD(DFN,ON) 72 K PSJREN 73 Q 74 H ; Hold 75 NEW TEX S TEX="Active order ***" 76 D HOLDHDR^PSJOE 77 D H^PSIVOPT(DFN,ON,P(17),P(3)) 78 D:P(17)="A" PAUSE^VALM1 79 D EN^PSJLIORD(DFN,ON) 80 Q 81 L ; Activity Log 82 NEW PSIVLAB,PSIVLOG,PSJHIS S (PSIVLAB,PSIVLOG)=1 83 D EN^PSIVVW1 84 D EN^PSJLIVMD 85 S VALMBCK="R" 86 Q 87 O ; On Call 88 NEW TEX S TEX="Active order ***" 89 D HOLDHDR^PSJOE 90 D O^PSIVOPT(DFN,ON,P(17),P(3)) 91 D:P(17)="A" PAUSE^VALM1 92 D EN^PSJLIORD(DFN,ON) 93 Q 94 VF ; Make the order active 95 NEW PSIVCHG S PSIVCHG=0 96 I ON["V" S ON55=ON D VF1("V","ORDER VERIFIED BY ",1) Q 97 D ACTIVE^PSIVORC2 98 Q 99 VF1(PSIVREA,PSIVAL,PSIVLOG) ; 100 ;Update 4 node and set activity log. 101 ;PSIVREA: the reason use by LOG^PSIVORAL 102 ;PSIVAL : the description reason 103 ;PSIVLOG: Log an activity if = 1 104 I '+$G(OD)!($L($G(OD))>16) K OD 105 D:+PSJSYSU=3 ^PSIVORE1 106 NEW DIE,DA,DR,PSJX,XX,PSIVACT,PSJRQND 107 S PSIVACT=1 108 S PSJX=$G(^PS(55,DFN,"IV",+ON55,4)),XX="" 109 I $P(PSJX,U)="" S XX=";143////0" 110 I $P(PSJX,U,4)="" S XX=XX_U_";142////0" 111 D NOW^%DTC 112 S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN 113 I +PSJSYSU=3 S DR="140////"_DUZ_";141////"_$E(%,1,12)_";142////1"_$P(XX,U) 114 I +PSJSYSU=1 S DR="16////"_DUZ_";17////"_$E(%,1,12)_";143////1"_$P(XX,U,2) 115 I $G(P("PRY"))="D" S DR=DR_";.22////"_+P("IVRM") 116 D ^DIE 117 ; If pending IV renew is edited during finish, go back and DE the original active order left in RENEWED status 118 S PREREN=$S(ON55["V":$G(@(DIE_"+ON55,2)")),1:""),PREREN=$P(PREREN,"^",5) I PREREN D K PREREN 119 . I PREREN["P" S PREREN=$G(@("^PS(53.1,+PREREN,0)")),PREREN=$P(PREREN,"^",25) 120 . I PREREN["V" N PRERENOD S PRERENOD=$G(@("^PS(55,DFN,""IV"",+PREREN,0)")) I $P(PRERENOD,"^",17)="R",($G(P("RES"))="E") D 121 .. S DIE="^PS(55,"_DFN_",""IV"",",DA=+PREREN,DA(1)=DFN 122 .. S DR="100////D;.03////"_PSGDT S ORIGSTOP=$P($G(@("^PS(55,DFN,""IV"",+PREREN,2)")),"^",3) I ORIGSTOP S DR=DR_";116////"_ORIGSTOP 123 .. D ^DIE D EN1^PSJHL2(DFN,"SC",PREREN) 124 K DR,DIE,DA 125 ;I ((+PSJSYSU=3)&($G(PSJPRI)="D"))!((+PSJSYSU=3)&($G(P("PRY"))="D")) D 126 I (+PSJSYSU=3)&($G(P("PRY"))="D") D 127 .N DIR W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Do you want to enter a Progress Note",DIR("B")="No" D ^DIR 128 .Q:Y="N" 129 .D MAIN^TIUEDIT(3,.TIUDA,DFN,"","","","",1) 130 Q:'$G(PSIVLOG) 131 I $G(P("PACT"))]"",+$P(P("PACT"),U,2),+$P(P("PACT"),U,3) D 132 . NEW DIC,DA,X,Y,XX,DO D NAME^PSJBCMA1($P(P("PACT"),U,2),.XX) 133 . S DIC(0)="L",DA(1)=DFN,DA(2)=+ON55,X=1 134 . S DIC="^PS(55,"_DA(1)_",""IV"","_DA(2)_",""A""," 135 . S DIC("DR")=".02////F;.03////"_XX_";.04////"_$P($G(^PS(53.3,+$P(P("PACT"),U,3),0)),U)_";.05////"_$P(P("PACT"),U)_";.06////"_$P(P("PACT"),U,2) 136 . D FILE^DICN 137 NEW PSIVALCK 138 S PSIVREA="V",PSIVALT="" 139 S PSIVAL=PSIVAL_$S(+PSJSYSU=3:"PHARMACIST",1:"NURSE") 140 D LOG^PSIVORAL K PSIVAL,PSIVREA,PSIVLN 141 I $G(PSJORD)["P" S PSIVREA="V",PSIVALT="",PSGRDTX=$G(^PS(53.1,+PSJORD,2.5)) D 142 . I $G(PSGRDTX) S PSIVAL="Requested Start Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U))) D LOG^PSIVORAL 143 . I $P(PSGRDTX,U,3) S PSIVREA="V",PSIVALT="" S PSIVAL="Requested Stop Date: "_$$ENDTC^PSGMI($$DATE2^PSJUTL2($P(PSGRDTX,U,3))) D LOG^PSIVORAL 144 N DUR I $G(PSJORD) S DUR=$$GETDUR^PSJLIVMD(DFN,+PSJORD,$S(PSJORD["P":"P",1:"IV"),1) I DUR]"" D 145 . K DR S DIE="^PS(55,"_DFN_",""IV"",",DA=+ON55,DA(1)=DFN 146 . S DR=$S($G(IVLIMIT):"152////"_DUR,1:"151////"_DUR) K IVLIMIT 147 . D ^DIE 148 D EN1^PSJHL2(DFN,"SC",ON55) 149 D:+PSJSYSU=1 EN1^PSJHL2(DFN,"ZV",ON55) 150 D GT55^PSIVORFB S OLDON=$P($G(^PS(55,DFN,"IV",+ON55,2)),"^",5),P("OLDON")=OLDON 151 N PSJPRIO,PSJSCH,NODE0,NODEP2 S NODE0=$G(^PS(55,DFN,"IV",+ON55,0)),NODEP2=$G(^PS(55,DFN,"IV",+ON55,.2)) 152 S PSJPRIO=$P(NODEP2,"^",4),PSJSCH=$P(NODE0,"^",9) 153 I (",S,A,")[(","_$G(PSJPRIO)_",")!($G(PSJSCH)="NOW")!($G(PSJSCH)["STAT") D NOTIFY^PSJHL4(ON55,DFN,$G(PSJPRIO),$G(PSJSCH)) 154 Q
Note:
See TracChangeset
for help on using the changeset viewer.
