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

PSGOE92.m

Go to the documentation of this file. 
  1. PSGOE92 ;BIR/CML - ACTIVE ORDER EDIT (CONT.) ;2/18/10 4:15pm
  1.  ;;5.0;INPATIENT MEDICATIONS ;**2,35,50,58,81,110,215,237,276,316,317,366,327,372**;16 DEC 97;Build 153
  1.  ;
  1.  ;Reference to ^DD(53.1 is supported by DBIA #2256.
  1.  ;Reference to ^PS(55 is supported by DBIA #2191.
  1.  ;Reference to ^PSDRUG is supported by DBIA #2192.
  1.  ;Reference to $$GET^XPAR is supported by DBIA #2263
  1.  ;Reference to $$SDEA^XUSER supported by DBIA #2343
  1.  ;
  1. 1 ; provider
  1.  S MSG=0,PSGF2=1 S:PSGOEEF(PSGF2) BACK="1^PSGOE92"
  1. A1 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D  G DONE
  1.  . W !!?5,"Provider may not be edited for active complex orders." D PAUSE^VALM1
  1.  W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
  1.  ;; START NCC T4 MODS >> 327*RJS
  1.  S PSTMPI=PSGPR,PSTMPN=PSGPRN
  1.  I $S(X="":'PSGPR,1:X="@") W $C(7),"  (Required)" S X="?" D ENHLP^PSGOEM(55.06,1) G A1
  1.  I +$G(ANQX) G A2
  1.  I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$L($$GET1^DIQ(200,PSGPR,53.1)) G DONE
  1.  I X?1."?" D ENHLP^PSGOEM(55.06,1)
  1.  I $E(X)="^" D ENFF G:Y>0 @Y G A1
  1.  ;*366 - check provider credentials
  1.  K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="I $$ACTPRO^PSGOE1(+Y)" D ^DIC K DIC I Y'>0 G A1
  1. A2 D CLOZPRV^PSGOE82
  1.  I $G(ANQX) W ! S PSGPR=PSTMPI,PSGPRN=PSTMPN  K PSTMPN,PSTMPI,ANQX G A1
  1.  ;; END NCC T4 MODS << 327*RJS
  1.  S PSGPR=+Y,PSGPRN=Y(0,0)
  1.  N PSJDEA,PSDEA,PDEA,PSPPKG
  1.  I $G(PSGPDRG)]"" D
  1.  .S PSPPKG=$S(PSJPROT=1:"U",PSJPROT=3:"UI",1:"") Q:PSPPKG=""
  1.  .S PSJDEA=$$OIDEA^PSSOPKI(PSGPDRG,PSPPKG),PSDEA=$P(PSJDEA,";",2) I +PSDEA>=2,+PSDEA<=5 S PDEA=$$SDEA^XUSER(,+PSGPR,PSDEA,,"I")
  1.  I ($G(PDEA)=2)!($G(PDEA)=1)!(+$G(PDEA)=4) D  G A1
  1.  .W !,"Provider not authorized to prescribe medications in Federal Schedule "_PSDEA_".",!,"Please contact the provider.",!
  1.  .S PSGPR=PSTMPI,PSGPRN=PSTMPN K PSTMPN,PSTMPI
  1.  G DONE
  1.  ;
  1. 5 ; self med
  1.  I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D  G DONE
  1.  . W !!?5,"Self Med may not be edited for active complex orders." D PAUSE^VALM1
  1.  S MSG=0,PSGF2=5 S:PSGOEEF(PSGF2) BACK="5^PSGOE92" K PSGOEEF(6) S:PSGSM PSGOEEF(6)=""
  1. A5 W !,"SELF MED: " W:PSGSM]"" $P("NO^YES","^",PSGSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
  1.  I "01"[X,$L(X)<2 S:X]"" PSGSM=+X W:PSGSM]"" "  (",$P("NO^YES","^",PSGSM+1),")" G:'PSGSM DONE S PSGOEEF(6)="" G 6
  1.  I X="@" W $C(7),"  (Required)" G A5
  1.  I X?1"^".E D ENFF G:Y>0 @Y G A5
  1.  I X?1."?" D ENHLP^PSGOEM(55.06,5) G A5
  1.  D YN I  S PSGSM=$E(X)="Y" K PSGOEEF(6) G:'PSGSM DONE S PSGOEEF(6)="" G 6
  1.  W $C(7) D ENHLP^PSGOEM(55.06,5) G A5
  1.  ;
  1. 6 ; hospital supplied self med
  1.  S MSG=0,PSGF2=6 S:PSGOEEF(PSGF2) BACK="6^PSGOE92"
  1. A6 I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D  G DONE
  1.  . W !!?5,"Hospital Supplied Self Med may not be edited for active complex orders." D PAUSE^VALM1
  1.  W !,"HOSPITAL SUPPLIED SELF MED: " W:PSGHSM]"" $P("NO^YES","^",PSGHSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
  1.  I "01"[X,$L(X)=1 S:X]"" PSGHSM=+X W "  (",$P("NO^YES","^",PSGHSM+1),")" S MSG=0,PSGF2=5 G DONE
  1.  I X="@" W $C(7),"  (Required)" G A6
  1.  I X?1"^".E D ENFF G:Y>0 @Y G A6
  1.  I X?1."?" D ENHLP^PSGOEM(55.06,6) G A6
  1.  D YN I  S PSGHSM=$E(X)="Y" S MSG=0,PSGF2=5 G DONE
  1.  W $C(7) D ENHLP^PSGOEM(55.06,6) G A6
  1.  ;
  1. 2 ; dispense drug multiple
  1.  ;*276 - Disallow unauthorized nurses from editing Dispense Drug
  1.  I '$P($G(PSJSYSU),";",4) W !,"You are not authorized to edit Dispense Drugs." D PAUSE^VALM1 Q
  1.  I $G(PSGP),$G(PSGORD) I $$COMPLEX^PSJOE(PSGP,PSGORD) D
  1.  .N X,Y,PARENT S PARENT=$S(PSGORD["U":$$GET1^DIQ(55.06,+PSGORD_","_PSGP,125,"I"),1:$$GET1^DIQ(53.1,+PSGORD,125,"I"))
  1.  .I PARENT D FULL^VALM1 W !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order." D CMPLX^PSJCOM1(PSGP,PARENT,PSGORD)
  1.  S MSG=0,PSGF2=2,BACK="2^PSGOE92",PSGOEEND=1
  1.  N PSGX,ARRAY D LIST^DIC(53.4502,","_PSJSYSP_",",,"I",,,,,,,"ARRAY") S PSGX=+ARRAY("DILIST",0)
  1.  ; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display as identifier.
  1.  N PSJPADLK S PSJPADLK=0  ; Flag indicating PADE drug lookup was done, don't do drug lookup twice - PSJ*5*317
  1.  I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
  1.  .N DA,DIC,DIE,DR,DIR,PSJLOC,PSJDRG,PSJDDC,PSJORD,DFN,PSJORCL,PSJCLNK,PSJCLND S PSJCLND=""
  1.  .; If clinic order, quit if clinic location is not linked to PADE
  1.  .I $G(PSGORD)["P" S PSJCLND=$$GET1^DIQ(53.1,+$G(PSGORD),113,"I")_"^"_$$GET1^DIQ(53.1,+$G(PSGORD),126,"I") I 1
  1.  .E  I $G(PSGORD)["U" S PSJCLND=$$GET1^DIQ(55.06,+$G(PSGORD)_","_+$G(PSGP),130,"I")_"^"_$$GET1^DIQ(55.06,+$G(PSGORD)_","_+$G(PSGP),131,"I") I 1
  1.  .E  I $G(PSGORD)["V" S PSJCLND=$$GET1^DIQ(55.01,+$G(PSGORD)_","_+$G(PSGP),136,"I")_"^"_$$GET1^DIQ(55.01,+$G(PSGORD)_","_+$G(PSGP),139,"I")
  1.  .S PSJORCL=$S(PSJCLND&$P(PSJCLND,"^",2):+PSJCLND_"C",1:"")
  1.  .I PSJORCL S PSJCLNK=$$PADECL^PSJPAD50(+$G(PSJORCL)) Q:'PSJCLNK
  1.  .I '$G(PSJCLNK) Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4)))
  1.  .S DFN=$G(PSGP),PSJORD=$G(PSGORD)
  1.  .N ARRAY D LIST^DIC(53.4502,","_PSJSYSP_",",,"I",,,,,,,"ARRAY")
  1.  .F I=1:1 Q:'$D(ARRAY("DILIST",2,I))  S PSJDDC=ARRAY("DILIST",2,I),PSJDRG(PSJDDC)=$$GET1^DIQ(53.4502,PSJDDC_","_PSJSYSP,.01,"I")
  1.  .S PSJLOC=$S($G(PSJORD)["U":+$$GET1^DIQ(55.06,+PSJORD_","_DFN,130,"I")_"C",$G(PSJORD)["P":+$$GET1^DIQ(53.1,+$G(PSGORD),113,"I")_"C",1:"")
  1.  .S:'PSJLOC PSJLOC=+$G(VAIN(4)) I '$G(PSJLOC) D
  1.  ..N VAIN D INP^VADPT S PSJLOC=$G(VAIN(4))
  1.  .S PSJPADLK=1
  1.  .D READDD^PSJPAD50(.PSJDRG,$G(PSGPDRG),PSJLOC,PSJORD,$G(PSGORD))
  1.  ; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is NO, PADE balances should NOT display as identifer.
  1.  I '$G(PSJPADLK) N DA,DIE,DR S DIE="^PS(53.45,",DA=PSJSYSP,DR=2,DR(2,53.4502)=".02//1;.03" D ^DIE
  1.  I '$G(ARRAY("DILIST",0)) W $C(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!",! S MSG=1
  1.  D DDOC^PSGOE82(PSGX) ;* Perform allergy/adv. reaction order checks
  1.  N PSJDOSE
  1.  D DOSECHK^PSJDOSE
  1.  I +$G(PSJDSFLG) D DSPWARN^PSJDOSE S:$G(PSGOEEF(109))="" PSGOEEF(109)=1 ; PSJ*5*237 - Check PSGOEEF(109) to prevent infinite loop
  1.  ; PSJ*5*215 - If Dispense Drug(s) changed, make entry in Activity Log.
  1.  ; Compare the edited dispense drug information in ^PS(53.45 to the active
  1.  ; order dispense drug information in ^PS(55.
  1.  S (PSJDDTMP,PSJDD55,PSJDTMP1,PSJDD551)=""
  1.  N ARRAY D LIST^DIC(53.4502,","_PSJSYSP_",",.02,"I",,,,,,,"ARRAY")
  1.  F I=1:1 Q:'$D(ARRAY("DILIST",2,I))  S PSJDDTMP=ARRAY("DILIST",2,I) D
  1.  .S PSJDDTMP(PSJDDTMP)=ARRAY("DILIST",1,I)_"^"_ARRAY("DILIST","ID",I,.02)
  1.  .S PSJDTMP1="Disp Drug: "_"("_$P($G(PSJDDTMP(PSJDDTMP)),"^",1)_") "_$$GET1^DIQ(50,$P($G(PSJDDTMP(PSJDDTMP)),"^",1),.01)_" Units: "_$P($G(PSJDDTMP(PSJDDTMP)),"^",2)_" "
  1.  N ARR1 D LIST^DIC(55.07,","_+ON_","_DFN_",",.02,"I",,,,,,,"ARR1")
  1.  F I=1:1 Q:'$D(ARR1("DILIST",2,I))  S PSJDD55=ARR1("DILIST",2,I) D
  1.  .S PSJDD55(PSJDD55)=ARR1("DILIST",1,I)_"^"_ARR1("DILIST","ID",I,.02)
  1.  .S PSJDD551="Disp Drug: "_"("_$P($G(PSJDD55(PSJDD55)),"^",1)_") "_$$GET1^DIQ(50,$P($G(PSJDD55(PSJDD55)),"^",1),.01)_" Units: "_$P($G(PSJDD55(PSJDD55)),"^",2)_" "
  1.  ; If the two temporary strings PSJDTMP1 and PSJDD551 do not match each other exactly
  1.  ; then an edit has been made to the Dispense Drug Field.  Make a new entry in
  1.  ; the Activity Log for this order.
  1.  I PSJDTMP1'=PSJDD551 D NEWUDAL^PSGAL5(DFN,+ON,6000,"Dispense Drug",PSJDD551)
  1.  K PSGOEEND,PSJDDTMP,PSJDTMP1,PSJDD55,PSJDD551 G DONE
  1.  ;
  1. 15 ; comments
  1.  I $G(PSJORD),$G(PSGP) I $$COMPLEX^PSJOE(PSGP,PSJORD) S PSGOEE=0 D  G DONE
  1.  . W !!?5,"Comments may not be edited for active complex orders." D PAUSE^VALM1
  1.  S MSG=0,PSGF2=15,BACK="15^PSGOE92",DA=PSJSYSP,DR=1,DIE="^PS(53.45," D ^DIE W ! G DONE
  1.  ;
  1. 72 ; provider comments
  1.  ;
  1. DONE ;
  1.  I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
  1.  K F,F0,PSGF2,F3,PSG,SDT Q
  1.  ;
  1. ENFF ; up-arrow to another field
  1.  S Y=-1 I '$D(PSGOEEF) W $C(7),"  ??" Q
  1.  S X=$E(X,2,99) I X=+X S Y=$S($D(PSGOEEF(X)):X,1:-1) W "  " W:Y>0 $$CODES2^PSIVUTL(53.1,X) W:Y'>0 $C(7),"??" Q
  1.  K DIC S DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I $D(PSGOEEF(+Y))" D ^DIC K DIC S Y=+Y S:Y>0 Y=$P($T(@("F"_Y)),";",3) Q
  1.  ;
  1. DEL ; delete entry
  1.  W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7),"  <NOTHING DELETED>"
  1.  Q
  1.  ;
  1. YN ; yes/no as a set of codes
  1.  I X'?.U F Y=1:1:$L(X) I $E(X,Y)?1L S X=$E(X,1,Y-1)_$C($A(X,Y)-32)_$E(X,Y+1,$L(X))
  1.  F Y="NO","YES" I $P(Y,X)="" W $P(Y,X,2) Q
  1.  Q
  1.  ;
  1. F101 ;;101^PSGOE9
  1. F109 ;;109^PSGOE9
  1. F3 ;;3^PSGOE9
  1. F7 ;;7^PSGOE9
  1. PSGF26 ;;26^PSGOE9
  1. F41 ;;41^PSGOE91
  1. F8 ;;8^PSGOE91
  1. F10 ;;10^PSGOE91
  1. F34 ;;34^PSGOE91
  1. F1 ;;1^PSGOE92
  1. F5 ;;5^PSGOE92
  1. PSGF2 ;;2^PSGOE92