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

ORY195.m

Go to the documentation of this file. 
  1. ORY195 ;SLCOIFO - Pre and Post-init for patch OR*3*195 [10/4/04 7:21am] ; [1/20/05 9:26am]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
  1.  ;
  1. PRE ; initiate pre-init processes
  1.  ;
  1.  ; Dump previously-installed param templates w/bad "B" x-ref entries:
  1.  ;
  1.  N DA,DIK
  1.  ;
  1.  S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (DIVISION)",0))
  1.  I +DA>0 S DIK="^XTV(8989.52," D ^DIK
  1.  ;
  1.  S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SERVICE)",0))
  1.  I +DA>0 S DIK="^XTV(8989.52," D ^DIK
  1.  ;
  1.  S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SYSTEM)",0))
  1.  I +DA>0 S DIK="^XTV(8989.52," D ^DIK
  1.  ;
  1.  S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (USER)",0))
  1.  I +DA>0 S DIK="^XTV(8989.52," D ^DIK
  1.  ;
  1.  Q
  1.  ;
  1. POST ; initiate post-init processes
  1.  ;
  1.  I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
  1.  I +$$PATCH^XPDUTL("OR*3.0*222") D GNRPCS
  1.  I +$$PATCH^XPDUTL("MAG*3.0*7") D MAGRPC1
  1.  I +$$PATCH^XPDUTL("MAG*3.0*37") D MAGRPC2
  1.  D SETIMO
  1.  D PARVAL
  1.  D STUFDTRG
  1.  D MAIL
  1.  D Q^ORY195A ;Queue lab order check routine
  1.  Q
  1.  ;
  1. MAIL ; send bulletin of installation time
  1.  N COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
  1.  S COUNT=0,XMDUZ="CPRS PACKAGE",XMTEXT="TEXT("
  1.  S XMSUB="Version "_$P($T(VERSION),";;",2)_" Installed"
  1.  F I="G.CPRS GUI INSTALL@ISC-SLC.DOMAIN.EXT",DUZ S XMY(I)=""
  1.  ;
  1.  S X=$P($T(VERSION),";;",2)
  1.  D LINE("Version "_X_" has been installed.")
  1.  D LINE(" ")
  1.  D LINE("Install complete:  "_$$FMTE^XLFDT($$NOW^XLFDT()))
  1.  ;
  1.  D ^XMD
  1.  Q
  1.  ;
  1. LINE(DATA) ; set text into array
  1.  S COUNT=COUNT+1
  1.  S TEXT(COUNT)=DATA
  1.  Q
  1.  ;
  1. SURGREG ; Register TIU SURGERY RPCs if TIU*1.0*112 present
  1.  N MENU,RPC
  1.  S MENU="OR CPRS GUI CHART"
  1.  F RPC="TIU IS THIS A SURGERY?","TIU IDENTIFY SURGERY CLASS","TIU LONG LIST SURGERY TITLES","TIU GET DOCUMENTS FOR REQUEST" D INSERT(MENU,RPC)
  1.  Q
  1.  ;
  1. INSERT(OPTION,RPC) ; Call FM Updater with each RPC
  1.  ; Input  -- OPTION   Option file (#19) Name field (#.01)
  1.  ;           RPC      RPC sub-file (#19.05) RPC field (#.01)
  1.  ; Output -- None
  1.  N FDA,FDAIEN,ERR,DIERR
  1.  S FDA(19,"?1,",.01)=OPTION
  1.  S FDA(19.05,"?+2,?1,",.01)=RPC
  1.  D UPDATE^DIE("E","FDA","FDAIEN","ERR")
  1.  Q
  1.  ;
  1. SETIMO ; Create "CLINIC MEDICATIONS" display group
  1.  N NDATA,DLG,IEN,X
  1.  S (NDATA,DLG,IEN,X)=""
  1.  S NDATA="CLINIC MEDICATIONS^Clin. Meds^C RX^"
  1.  N DIC
  1.  S DIC="^ORD(100.98,",DIC(0)="BX",X=$P(NDATA,U)
  1.  D ^DIC
  1.  I Y'=-1 S ^ORD(100.98,+Y,0)=NDATA Q
  1.  I Y=-1 S DIC(0)="L" D ^DIC
  1.  S DIC(0)="BX" D ^DIC
  1.  S IEN=+Y
  1.  I 'IEN Q
  1.  N DIE,DA,DR
  1.  S DIE="^ORD(100.98,",DA=IEN,DR="2///Clin. Meds;3///C RX"
  1.  D ^DIE
  1.  N DLAYGO
  1.  S DA(1)=$O(^ORD(100.98,"B","PHARMACY",0)) Q:'DA(1)
  1.  S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
  1.  S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="NLX",DLAYGO=100.98
  1.  S X="CLINIC MEDICATIONS" D ^DIC
  1.  K Y
  1.  Q
  1. PARVAL ;add Clin. Meds display group to SEQUENCE parameter
  1.  N X
  1.  Q:'$D(^ORD(100.98,"B","CLINIC MEDICATIONS"))
  1.  S X=0,X=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",X)) Q:'X  D 
  1.  . D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69,X)
  1.  Q
  1.  ;
  1. SCH ; -- Adjust admin schedule Help Msg for Non-Std Schedules
  1.  N SCH,I,DG,PKG,IPKG,DLG,PRMT,OR0
  1.  S SCH=+$O(^ORD(101.41,"B","OR GTX SCHEDULE",0)) Q:SCH<1
  1.  F I="I","UD","O","C" S X=+$O(^ORD(100.98,"B",I_" RX",0)) S:X DG(X)=""
  1.  F I="RX","SPLY" S X=+$O(^ORD(100.98,"B",I,0)) S:X DG(X)=""
  1.  F PKG="PSJ","PSO","PSS" D
  1.  . S IPKG=+$O(^DIC(9.4,"C",PKG,0))
  1.  . S DLG=0 F  S DLG=+$O(^ORD(101.41,"APKG",IPKG,DLG)) Q:DLG<1  D
  1.  .. S OR0=$G(^ORD(101.41,DLG,0)) Q:$P(OR0,U,4)'="D"  Q:'$D(DG($P(OR0,U,5)))
  1.  .. S PRMT=+$O(^ORD(101.41,DLG,10,"D",SCH,0)) Q:PRMT<1
  1.  .. S ^ORD(101.41,DLG,10,PRMT,1)="Enter a standard administration schedule."
  1.  Q
  1.  ;
  1. STUFDTRG ; Stuff existing date ranges into new parameters for CS and PCE.
  1.  ;
  1.  ; Get existing settings, stuff into new parameters.
  1.  ;
  1.  ; NOTE: ORQQCSDR params will allow "T, T+, T- settings.
  1.  ;       ORQQEAPT params allow single value number entries only.
  1.  ;
  1.  N ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORSTART,ORSTOP,ORVAL
  1.  ;
  1.  ; First deal with PKG level settings.
  1.  ;
  1.  ; Clean out any existing settings:
  1.  D NDEL^XPAR("PKG","ORQQEAPT ENC APPT START",.ORERR)
  1.  D NDEL^XPAR("PKG","ORQQEAPT ENC APPT STOP",.ORERR)
  1.  D NDEL^XPAR("PKG","ORQQCSDR CS RANGE START",.ORERR)
  1.  D NDEL^XPAR("PKG","ORQQCSDR CS RANGE STOP",.ORERR)
  1.  ;
  1.  ; Get settings of previously-used high level params:
  1.  S ORSTART=$$GET^XPAR("DIV^SYS^PKG","ORQQVS SEARCH RANGE START",1,"I")
  1.  I '$L(ORSTART) S ORSTART=90
  1.  S ORSTOP=$$GET^XPAR("DIV^SYS^PKG","ORQQAP SEARCH RANGE STOP",1,"I")
  1.  I '$L(ORSTOP) S ORSTOP=90
  1.  ;
  1.  ; Stuff retrieved values into PKG level of first set of new params:
  1.  D EN^XPAR("PKG","ORQQCSDR CS RANGE START",1,ORSTART)
  1.  D EN^XPAR("PKG","ORQQCSDR CS RANGE STOP",1,ORSTOP)
  1.  ;
  1.  ; Treat "start" value and stuff it:
  1.  S ORVAL=ORSTART,ORNEG=0
  1.  I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
  1.  I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
  1.  I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
  1.  I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
  1.  S ORVAL=+ORVAL
  1.  I 'ORNEG S ORVAL=0 ; Can't have later than "Today" for "start."
  1.  D EN^XPAR("PKG","ORQQEAPT ENC APPT START",1,ORVAL)
  1.  ;
  1.  ; Treat "stop" value and stuff it:
  1.  S ORVAL=ORSTOP,ORNEG=0
  1.  I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
  1.  I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
  1.  I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
  1.  I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
  1.  S ORVAL=+ORVAL
  1.  I ORNEG S ORVAL=0 ; Won't allow earlier than "Today" for "stop."
  1.  D EN^XPAR("PKG","ORQQEAPT ENC APPT STOP",1,ORSTOP)
  1.  ;
  1.  ; Deal with User level settings.
  1.  ;
  1.  S (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
  1.  ;
  1.  ; Begin with the START parameter:
  1.  D ENVAL^XPAR(.ORLST,"ORQQAP SEARCH RANGE START",1,.ORERR)
  1.  I 'ORERR,$G(ORLST)>0 D
  1.  .F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) D
  1.  ..S ORBZ=$P(ORBE,";",2)
  1.  ..I ORBZ="VA(200," S ORDUZ=$P(ORBE,";") I $L($G(ORDUZ)) D
  1.  ...S ORVAL=ORLST(ORBE,1) ; Current setting.
  1.  ...;
  1.  ...; Eliminate any existing entries:
  1.  ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",.ORERR)
  1.  ...;
  1.  ...; Stuff value:
  1.  ...D EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",1,ORVAL)
  1.  ...;
  1.  ...; Treat value:
  1.  ...S ORNEG=0
  1.  ...I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
  1.  ...I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
  1.  ...I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
  1.  ...I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
  1.  ...S ORVAL=+ORVAL
  1.  ...I 'ORNEG S ORVAL=0 ; Can't have later than "Today" for "start."
  1.  ...;
  1.  ...; Eliminate any existing entries:
  1.  ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",.ORERR)
  1.  ...;
  1.  ...; Stuff value:
  1.  ...D EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",1,ORVAL)
  1.  ;
  1.  ; Now do the STOP parameter:
  1.  S (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
  1.  ;
  1.  D ENVAL^XPAR(.ORLST,"ORQQVS SEARCH RANGE STOP",1,.ORERR)
  1.  I 'ORERR,$G(ORLST)>0 D
  1.  .F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) D
  1.  ..S ORBZ=$P(ORBE,";",2)
  1.  ..I ORBZ="VA(200," S ORDUZ=$P(ORBE,";") I $L($G(ORDUZ)) D
  1.  ...S ORVAL=ORLST(ORBE,1) ; Current setting.
  1.  ...;
  1.  ...; Eliminate any existing entries:
  1.  ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",.ORERR)
  1.  ...;
  1.  ...; Stuff value:
  1.  ...D EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",1,ORVAL)
  1.  ...;
  1.  ...; Treat parameter value:
  1.  ...S ORNEG=0
  1.  ...I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
  1.  ...I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
  1.  ...I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
  1.  ...I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
  1.  ...S ORVAL=+ORVAL
  1.  ...I ORNEG S ORVAL=0 ; Can't have earlier than "Today" for "stop."
  1.  ...;
  1.  ...; Eliminate any existing entries:
  1.  ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",.ORERR)
  1.  ...;
  1.  ...; Stuff value:
  1.  ...D EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",1,ORVAL)
  1.  ;
  1.  Q
  1.  ;
  1. GNRPCS ;
  1.  N MENU,I
  1.  S MENU="OR CPRS GUI CHART"
  1.  F I="ORWGN GNLOC","ORWGN AUTHUSR" D INSERT(MENU,I)
  1.  Q
  1.  ;
  1. MAGRPC1 ;  Register Imaging RPC if MAG*3.0*7 present (DBIA 4526)
  1.  D INSERT("OR CPRS GUI CHART","MAG4 REMOTE IMPORT")
  1.  Q
  1.  ;
  1. MAGRPC2 ; Register Imaging RPCS if MAG*3.0*37 installed (DBIA 4528/4530)
  1.  D INSERT("OR CPRS GUI CHART","MAG IMPORT CHECK STATUS")
  1.  D INSERT("OR CPRS GUI CHART","MAG IMPORT CLEAR STATUS")
  1.  Q
  1.  ;
  1. VERSION ;;25.28