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

PSOLMUTL.m

Go to the documentation of this file. 
  1. PSOLMUTL ;BIR/SAB - listman utilities ;29-May-2012 14:54;PLS
  1.  ;;7.0;OUTPATIENT PHARMACY;**19,46,84,99,131,132,1005,1006,1013,148,268,225,305,1015**;DEC 1997;Build 62
  1.  ;External reference FULL^VALM1 supported by dbia 10116
  1.  ;External reference $$SETSTR^VALM1 supported by dbia 10116
  1.  ;External reference EN2^GMRAPEMO supported by dbia 190
  1.  ;External reference to ^ORD(101 supported by DBIA 872
  1.  ;External reference to RE^VALM4 supported by dbia 10120
  1.  ;
  1.  ; Modified - IHS/CIA/PLS - 12/10/03 - Line HDR+3
  1.  ;            IHS/MSC/PLS - 10/11/07 - Line HDR+12 and HDR+14
  1.  ;                          09/16/2011 - Line HDR+8
  1. EN W @IOF S VALMCNT=0
  1.  D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!?5,"Site parameter must be defined!",! G INITQ
  1.  D EN^PSOLMPI
  1. INITQ Q
  1. HDR ;patient med profile display
  1.  K VALMHDR S HDR=^TMP("PSOHDR",$J,1,0)
  1.  S:^TMP("PSOHDR",$J,8,0) X=IORVON_"<A>"_IORVOFF,HDR=$$SETSTR^VALM1(X,HDR,80-$L(X),80) S VALMHDR(1)=HDR
  1.  I '(^TMP("PSOHDR",$J,8,0)) S PSONOAL="" D ALLERGY^PSOORUT2 I PSONOAL'="" D  K PSONOAL
  1.  .S X=IORVON_"<NO ALLERGY ASSESSMENT>"_IORVOFF,HDR=$$SETSTR^VALM1(X,HDR,80-$L(X),80) S VALMHDR(1)=HDR
  1.  ; IHS/CIA/PLS - 12/10/03 added call to retrieve HRN, HT and WT from PCC Vitals
  1.  ;S HDR="  PID: "_^TMP("PSOHDR",$J,2,0)
  1.  ;S VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_^TMP("PSOHDR",$J,7,0),HDR,52,27)
  1.  ;S HDR="  DOB: "_^TMP("PSOHDR",$J,3,0)_" ("_^TMP("PSOHDR",$J,4,0)_")"
  1.  ;S VALMHDR(3)=$$SETSTR^VALM1(" Wt(kg): "_^TMP("PSOHDR",$J,6,0),HDR,51,28)
  1.  ;IHS/MSC/PLS - 09/16/2011 - Added mask to SSN
  1.  ;S HDR="  PID: "_^TMP("PSOHDR",$J,2,0)_"  (HRN: "_$G(VA("PID"))_")"
  1.  S HDR="  PID: "_$$FMTSSN^APSPFUNC(^TMP("PSOHDR",$J,2,0))_"  (HRN: "_$G(VA("PID"))_")"
  1.  S VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_^TMP("PSOHDR",$J,7,0),HDR,52,27)
  1.  S HDR="  DOB: "_^TMP("PSOHDR",$J,3,0)_" ("_^TMP("PSOHDR",$J,4,0)_")"
  1.  S VALMHDR(3)=$$SETSTR^VALM1(" Wt(kg): "_^TMP("PSOHDR",$J,6,0),HDR,51,28)
  1.  S HDR="  SEX: "_$E(^TMP("PSOHDR",$J,5,0),1,45)  ;IHS/MSC/PLS - 10/11/07 - CHANGED 44 TO 45
  1.  S VALMHDR(4)=HDR
  1.  S $P(VALMHDR(5)," ",26)="  "_$E(^TMP("PSOHDR",$J,5,0),48,80)  ;IHS/MSC/PLS - 10/11/07 - CHANGED 30 TO 26
  1.  Q:$G(PS)="VIEW"!($G(PS)="DELETE")
  1.  ;S $P(VALMHDR(5)," ",30)=$E(^TMP("PSOHDR",$J,5,0),48,80)
  1.  S VALMHDR(6)=^TMP("PSOHDR",$J,9,0)
  1.  S VALMHDR(7)=^TMP("PSOHDR",$J,10,0)
  1.  Q
  1.  ;
  1. NEWALL(DFN) ; Enter Allergy info.
  1.  N PSOID D FULL^VALM1,EN2^GMRAPEM0,^PSOORUT2 S VALMBCK="R"
  1.  Q
  1. NEWSEL ;allows order selection by number instead of action
  1.  S Y=$P(XQORNOD(0),"=",2) N VALMCNT D NEWSEL^PSOORNE2
  1.  Q
  1. EDTSEL ;allows edit selection by number instead of action - active orders
  1.  N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOOREDT
  1.  Q
  1. SELAL ;selection of allergy by number instead of action - select allergy
  1.  N VALMCNT S Y=$P(XQORNOD(0),"=",2) D SELAL^PSOORDA
  1.  Q
  1. EDTNEW ;allows edit selection by number instead of action - new orders
  1.  N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE1
  1.  Q
  1. EDTRNEW ;allows edit selection by number instead of action - renew orders
  1.  N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE4
  1.  Q
  1. EDTPEN ;allows edit selection by number instead of action - pending orders
  1.  N VALMCNT S Y=$P(XQORNOD(0),"=",2),SEDT=1 G EDTSEL^PSOORNEW
  1.  Q
  1. HLDHDR ;keeps patient's header info
  1.  S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IORC
  1.  Q
  1.  ;
  1. BYPASS S:$G(PSOFDR) SIGOK=1 S Y=-1,VALMBCK="Q"
  1.  Q
  1. ACTIONS() ;screen actions on active orders
  1.  Q:$G(PKI1)=2 0
  1.  N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0
  1.  S Y=Y(0,0)
  1.  I Y="PSO REFILL" Q $S(PSOACT["R":1,1:0)
  1.  I Y="PSO RENEW" Q $S(PSOACT["N":1,1:0)
  1.  I Y="PSO REPRINT" Q $S(PSOACT["P":1,1:0)
  1.  I Y="PSO EDIT ORDERS" Q $S(PSOACT["E":1,1:0)
  1.  I Y="PSO RELEASE" Q $S(PSOACT["L":1,1:0)
  1.  I Y="PSO PARTIAL" Q $S(PSOACT["T":1,1:0)
  1.  I Y="PSO CANCEL" Q $S(PSOACT["D":1,1:0)
  1.  I Y="PSO HOLD" Q $S(PSOACT["H":1,1:0)
  1.  I Y="PSO UNHOLD" Q $S(PSOACT["U":1,1:0)
  1.  I Y="PSO LM BACKDOOR COPY" Q $S(PSOACT["C":1,1:0)
  1.  I Y="PSO VERIFY" Q $S(PSOACT["V":1,1:0)
  1.  I Y="PSO ACTIVITY LOGS" Q 1
  1.  Q 1
  1. ACTIONS1() ;screen actions on pending orders
  1.  Q:$G(PKI1)=2 0
  1.  N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0
  1.  S Y=Y(0,0)
  1.  I Y="PSO LM DISCONTINUE" Q $S(PSOACT["D":1,1:0)
  1.  I Y="PSO LM EDIT" Q $S(PSOACT["E":1,1:0)
  1.  I Y="PSO LM FINISH" Q $S(PSOACT["F":1,1:0)
  1.  I Y="PSO LM FLAG" Q $S(PSOACT["X":1,1:0)
  1.  Q 1
  1. PKIACT() ;screen actions on pending orders DEA/PKI proj.
  1.  Q:$G(PKI1)=2 0
  1.  Q 1
  1. RFDSP ;screen action to toggle display of prescriptions between LAST FILL date and LAST RELEASE Date.
  1.  S PSORFG='$G(PSORFG)
  1.  I '$D(PSOSD) D ^PSOBUILD
  1.  D ^PSOORUT2,BLD^PSOORUT1
  1.  K VALMHDR
  1.  D RE^VALM4
  1.  Q