Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJLMGUD

PSJLMGUD.m

Go to the documentation of this file. 
  1. PSJLMGUD ;BIR/MLM-INITIALIZE UNIT DOSE ORDER FIELDS FOR DISPLAY ;05 Feb 99 / 9:46 AM
  1.  ;;5.0; INPATIENT MEDICATIONS ;**25,58,85,116,110,111**;16 DEC 97
  1.  ;
  1.  ; Reference to ^PS(51.2 is supported by DBIA 2178
  1.  ; Reference to ^PSDRUG( is supported by DBIA 2192 
  1.  ; Reference to ^PS(55   is supported by DBIA 2191
  1.  ; Reference to ES^ORX8 is supported by DBIA 3632
  1.  ;
  1. GETUD(DFN,PSGORD) ;
  1.  ;
  1. EN2 ;
  1.  N %X,%Y,ND2,DO,DRGI,FD,FL,FQC,NF,ND,PRI,SD,SIG,ST,STD,X,Y,ESIG
  1.  K GMRAL,P
  1.  S NF=$S(PSGORD["U":0,PSGORD["A":0,PSGORD["O":0,1:1) I NF,$D(^PS(53.1,+PSGORD,0)),$P(^(0),"^",19),$D(^PS(55,DFN,5,$P(^(0),"^",19))),(+$P(^(0),"^",19)'=+$P(^(0),"^",25)) S PSGORD=+$P(^PS(53.1,+PSGORD,0),"^",19)_"U",NF=0
  1.  S (FL,Y)="",$P(FL,"-",71)="",PSGOEEWF="^PS("_$S(NF:"53.1,",1:"55,"_DFN_",5,")_+PSGORD_","
  1.  ; The naked reference on the line below refers to the full reference created by indirect reference to F, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
  1.  S ND=$G(@(PSGOEEWF_"0)")),ND2=$G(^(2)),PSGEB=$P($G(^(4)),"^",7),PSGOSI=$G(^(6)),SIG=$G(^(6.5)),DO=$G(^(.2)),PSGOINST=$G(^(.3)),ESIG=$P(DO,U,3),PSG14=$P($G(^(14,0)),"^",3)
  1.  I PSG14 S PSGLRN=$G(@(PSGOEEWF_"14,"_PSG14_",0)"))
  1.  S PSGOPD=+DO,PSGODO=$P(DO,U,2),PSGOPDN=$$OINAME^PSJLMUTL(+DO),X=$P(DO,U,4),PSGPRIO=$P("STAT^ASAP^ROUTINE^PREOP^TIME CRITICAL^DONE",U,$F("SARPTD",X)-1),PSJPRI=X
  1.  S PSGOPR=$P(ND,"^",2),PSGOMR=$P(ND,"^",3),PSGOSM=$P(ND,"^",5),PSGOHSM=$P(ND,"^",6),(PSGOST,ST)=$P(ND,"^",7),STT=$P(ND,"^",9),PSGOMRN=$S('PSGOMR:"",1:$P($G(^PS(51.2,PSGOMR,0)),"^")) S:PSGOMRN="" PSGOMRN=PSGOMR
  1.  S PSGLI=$P(ND,U,16),PSGOSCH=$P(ND2,"^"),(PSGOSD,SD)=$P(ND2,"^",2),(FD,PSGOFD)=$P(ND2,"^",4),(FQC,PSGS0XT)=$P(ND2,"^",6),(PSGOAT,PSGS0Y)=$P(ND2,"^",5)
  1.  S PSGLIN=$$ENDD^PSGMI(PSGLI)_U_$$ENDTC^PSGMI(PSGLI)
  1.  ;I FQC="D",PSGOAT="" S PSGOAT=$E($P(SD,".",2)_"0000",1,4)
  1.  S PRI=$S('PSGOPR:0,1:$P($G(^VA(200,PSGOPR,"PS")),"^",4)),DRGI=$S(PSGOPD'=+PSGOPD:0,1:+$G(^PSDRUG(+PSGOPD,"I"))) S:PRI PRI=DT'<PRI S:DRGI DRGI=DT'<DRGI
  1.  S PSGOPRN=$S('PSGOPR:"",1:$P($G(^VA(200,PSGOPR,0)),"^")) S:PSGOPRN="" PSGOPRN=PSGOPR I PSGOSI]"" S PSGOSI=$$ENSET^PSGSICHK(PSGOSI)
  1.  I $L($T(ES^ORX8)) N ESIG1 S ESIG1=$$ES^ORX8(+$P(ND,U,21)_";1") S:ESIG1=1 ESIG="ES"
  1.  S PSGOPRN=PSGOPRN_$S(ESIG]"":" ["_$$LOW^XLFSTR(ESIG)_"]",1:"")
  1.  S PSGEBN=$$ENNPN^PSGMI(PSGEB) S:$P(ND,U,27)="R" STT="R"
  1.  S X=STT,PSGSTAT=$S(X="":"NOT FOUND",X="DE":"DISCONTINUED (EDIT)",X="DR":"DISCONTINUED (RENEWAL)",X="RE":"REINSTATED",1:$P(X_"^ACTIVE^DISCONTINUED^EXPIRED^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^RENEWED^UNRELEASED","^",$F("ADEHINPRU",X)))
  1.  ;
  1. SET ;
  1.  I STT="P" S (FD,SD,ST)=""
  1.  S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I SD S PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC^PSGMI(SD)
  1.  I FD S PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC^PSGMI(FD)
  1.  F X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO","AT" S @("PSG"_X)=@("PSGO"_X)
  1.  K ^PS(53.45,PSJSYSP,1),^(2) S %X=PSGOEEWF_"3,",%Y="^PS(53.45,"_PSJSYSP_",1," D %XY^%RCR S %X=PSGOEEWF_"1,",%Y="^PS(53.45,"_PSJSYSP_",2," D %XY^%RCR
  1.  S $P(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
  1.  K PSJNSS I $G(PSGSCH)'="" D  K PSJNSS
  1.  . ;N PSGS0XT,PSGOES,Y S X=PSGSCH N PSGSCH S PSGSCH="" S:($G(VALMBCK)]"")!'$G(NSFF)!$G(PSJTUD) PSGOES=1 D ENOS^PSGS0
  1.  . N PSGS0XTO,Y,PSGOES S X=PSGSCH S PSGS0XTO=PSGS0XT N PSGOSCH S PSGOSCH=PSGSCH S PSGSCH="",PSGOES=1
  1.  . D ENOS^PSGS0 S:$G(X)="" PSGS0XT=PSGS0XTO S PSGSCH=$S($G(X)]""&($G(PSGS0XT)="D"):X,1:PSGOSCH)
  1.  Q
  1.  ;
  1. FINISH ;
  1.  I '$G(PSGS0XT),PSGOSCH]"" D  S $P(^PS(53.1,+PSGORD,2),"^",6)=PSGS0XT
  1.  .N PSGOES,PSGS0Y S X=PSGOSCH,PSGOES=1 D ENOS^PSGS0
  1.  S PSGOEFF=PSGOSCH=""+('$O(^PS(53.45,PSJSYSP,2,0))*10) I PSGOEFF S X=$S(PSGOEFF#2:" a SCHEDULE",1:"")_$S(PSGOEFF=11:" and",1:"")_$S(PSGOEFF>9:" at least one DISPENSE DRUG",1:"")_" before it can be finished."
  1.  I PSGOEFF W $C(7),!!,"PLEASE NOTE: This order must have" F Q=1:1:$L(X," ") S Y=$P(X," ",Q) W:$L(Y)+$X>78 ! W Y," "
  1.  I PSGOEFF#2 S F1=53.1,MSG=0,Y=$T(35),@("PSGFN(35)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(35),";",3) G:'PSGOEE DONE
  1.  I PSGOEFF>9 S CHK=7 D ENDRG^PSGOEF1(PSGOPD,0) G:CHK DONE
  1.  I $G(MSG) K DIR S DIR(0)="E" W !! D ^DIR
  1.  I PSGOEFF D:PSGST="" GTST^PSGOE6(+PSGORD) N XQORM D EN^VALM("PSJ LM OE DISPLAY") G DONE ;D ENW^PSGOEEW
  1.  ;
  1. ACCEPT ;
  1.  D UPD^PSGOEF1 G DONE
  1. BYPASS ;
  1.  S PSGCANFL=1 G DONE
  1.  ;
  1. EDIT ;    
  1.  S PSGPDRG=PSGOPD,PSGPDRGN=PSGOPDN K PSGOEEND D ENF^PSGOEE I PSGCANFL=-1 D UPD^PSGOEF1
  1.  ;
  1. DONE ;
  1.  K CHK,DA,DIE,DR,DRG,MSG,ORETURN,ORIFN,PSGEB,PSGEFN,PSGND,PSGOEE,PSGOEEF,PSGOEEND,PSGOEEG,PSGOEF,PSGOEFF,PSGOES,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGPDRG,PSGDRGN,PSG0XT,PSGS0Y,OSGSD,Q1,Q2
  1.  Q
  1.  ;
  1.  ;
  1. 31 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
  1. 32 ;;109^PSGOE8;PSGODO;PSGDO;102;PSGODO]""
  1. 33 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
  1. 34 ;;7^PSGOE8;PSGOST;PSGST;7;0
  1. 35 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
  1. 36 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
  1. 37 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
  1. 38 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
  1. 39 ;;2^PSGOE82;;;2;0
  1. 310 ;;40^PSGOE82;;;40;0
  1. 311 ;;66^PSGOE82;;;66;1
  1. 312 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
  1. 313 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
  1. 314 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
  1.  ;
  1. AH ;
  1.  W !!?2,"Answer 'YES' to accept this order as a NON-VERIFIED UNIT DOSE order.  Answer",!,"'NO' to edit this order now.  Enter '^' to BYPASS this order, leaving it as",!,"a PENDING INPATIENT order."
  1.  Q