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

ORY215.m

Go to the documentation of this file. 
  1. ORY215 ;SLCOIFO - Pre and Post-init for patch OR*3*215 [10/21/04 6:30am] ;1/26/06  15:20
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
  1.  ;
  1.  ; DBIA 2336   EN^XPAR   ^TMP($J,"XPARRSTR")
  1.  ;
  1. PRE ; initiate pre-init processes
  1.  D PEOMPRE
  1.  D PEOMRPT
  1.  Q
  1.  ;
  1. POST ; initiate post-init processes
  1.  ;
  1.  I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
  1.  D VITREG ;register Vitals RPC
  1.  I +$$PATCH^XPDUTL("MAG*3.0*7") D MAGREG1
  1.  I +$$PATCH^XPDUTL("MAG*3.0*37") D MAGREG2
  1.  D PEOM ;set-up Outpatient Meals
  1.  D DLGBULL
  1.  D IVUPDT
  1.  D CMUPDT
  1.  D PARVAL
  1.  D MAIL
  1.  D PARAM
  1.  D NOTIF
  1.  D INISET^ORWGAPIU ; graph setting default
  1.  D BULLMG
  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. 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. VITREG ; Register Vitals RPC
  1.  D ADDRPCS^GMV3PST ;call tag from vitals patch post init to register
  1.  Q
  1.  ;
  1. MAGREG1 ; Register Imaging RPC if MAG*3.0*7 installed (DBIA 4526)
  1.  D INSERT("OR CPRS GUI CHART","MAG4 REMOTE IMPORT")
  1.  Q
  1.  ;
  1. MAGREG2 ; 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. LINE(DATA) ; set text into array
  1.  S COUNT=COUNT+1
  1.  S TEXT(COUNT)=DATA
  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. PEOMPRE ;Remove Print fields and Print format entries before installing new
  1.  N Y,DIK,ORK,DA
  1.  S DIK="^ORD(100.22,"
  1.  F ORK=2002,2003,2004,2005,2006 S DA=ORK D ^DIK
  1.  S DIK="^ORD(100.23,"
  1.  F ORK=1036,1037,1038 S DA=ORK D ^DIK
  1.  Q
  1. PEOMRPT ;Remove new & changed reports from OE/RR REPORTS file (101.24)
  1.  N ORVIT,ORI
  1.  S ORVIT=0
  1.  I $P($G(^ORD(101.24,34,0)),"^",1)="ORCV VITALS" D
  1.  . S ORVIT=1,DA=34,DIK="^ORD(101.24," D ^DIK
  1.  . S ^ORD(101.24,34,0)="ORCV VITALS",^ORD(101.24,"B","ORCV VITALS",34)=""
  1.  N APPTRPT
  1.  S APPTRPT=$G(^ORD(101.24,35,0))
  1.  I $P(APPTRPT,U)="ORCV APPOINTMENTS",$P(APPTRPT,U,5)="ORWCV",$P(APPTRPT,U,6)="VST" D
  1.  . S $P(^ORD(101.24,35,0),U,6)="VST1"
  1.  I 'ORVIT S ORVIT=$O(^ORD(101.24,"B","ORCV VITALS",0)) D
  1.  . Q:'ORVIT
  1.  . S DA=ORVIT,DIK="^ORD(101.24," D ^DIK
  1.  . S ^ORD(101.24,ORVIT,0)="ORCV VITALS",^ORD(101.24,"B","ORCV VITALS",ORVIT)=""
  1.  N ORI
  1.  S ORI=999
  1.  F  S ORI=$O(^ORD(101.24,ORI)) Q:'ORI  I ORI<1110!(ORI>1116) S DA=ORI,DIK="^ORD(101.24," D ^DIK
  1.  Q  ;Don't step on Rich's patch 151
  1. PEOM ; -- setup Outpatient Meals
  1.  N DA,DIC,DIE,DR,DLAYGO,X,Y,DO,DD,ID,ORDG
  1.  S ORDG=$O(^ORD(100.98,"B","DIET",0)) Q:'ORDG
  1.  ; create new Orderable Item
  1.  S X="NO MEAL",Y=+$O(^ORD(101.43,"S.DIET",X,0)) Q:Y>0  ;not 1st install
  1.  S DIC="^ORD(101.43,",DIC(0)="LX",DLAYGO=101.43,DIE=DIC
  1.  K DO,DD D FILE^DICN Q:Y'>0  ; error
  1.  S DA=+Y,ID=DA_";99ORD",DR="1.1///NO MEAL;2///^S X=ID;5////"_ORDG D ^DIE
  1.  K DA,DIC,DIE,DR,DLAYGO,X,Y,DO,DD
  1.  ; link new Display Group to DIETETICS
  1.  S X=$O(^ORD(100.98,"B","MEAL",0)),DA(1)=ORDG Q:'X
  1.  I $O(^ORD(100.98,DA(1),1,"B",X,0)) Q  ;not first install - done.
  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="OUTPATIENT MEALS" D ^DIC
  1.  D SETFHPRT
  1.  Q
  1. DLGBULL ; send bulletin about modified dialogs <on first install>
  1.  N I,ORD
  1.  F I="FHW2","FHW7","FHW8","RA OERR EXAM","LR OTHER LAB TESTS" S ORD(I)=""
  1.  D EN^ORYDLG(215,.ORD)
  1.  Q
  1.  ;
  1. CMUPDT ;
  1.  N AIEN,CIEN,DIE,DR,DA,FDA,NAME
  1.  S DA=$O(^ORD(100.98,"B","CLINIC MEDICATIONS","")) I +$G(DA)>0 D
  1.  .S CIEN=DA
  1.  .S DIE="^ORD(100.98,",DR=".01///CLINIC ORDERS",DR=DR_";2///Clinic Orders"
  1.  .D ^DIE
  1.  I $G(CIEN)'>0 S CIEN=$O(^ORD(100.98,"B","CLINIC ORDERS",""))
  1.  S AIEN=$O(^ORD(100.98,"B","ALL SERVICES",""))
  1.  I $D(^ORD(100.98,AIEN,1,"B",CIEN))>0 Q
  1.  S FDA(100.981,"+2,"_AIEN_",",.01)=CIEN
  1.  D UPDATE^DIE("","FDA","","MSG")
  1.  Q
  1. PARVAL ; Set parameter values
  1.  ; Set VistaWeb Parameter
  1.  D EN^XPAR("PKG","ORWRP VISTAWEB ADDRESS",1,"https://vhaiswwebv7.vha.domain.ext/vistaweb/ToolsPage.aspx")
  1.  D EN^XPAR("PKG","ORWRP REPORT LIST",6,"ORRPW HDR")
  1.  Q
  1. IVUPDT ;
  1.  N IVDG S IVDG=0
  1.  S IVDG=$O(^ORD(100.98,"B","IV MEDICATIONS",0))
  1.  S:IVDG $P(^ORD(100.98,IVDG,0),U,2)="Infusion"
  1.  N IVMN,IVODSP S IVMN=0,IVODSP=""
  1.  S IVMN=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE MENU",0))
  1.  I IVMN D
  1.  . S IVODSP=$P(^ORD(101.41,IVMN,0),U,2)
  1.  . S $P(^ORD(101.41,IVMN,0),U,2)="IV FLUIDS AND INFUSION ORDER"
  1.  . S ^ORD(101.41,"C","IV FLUIDS AND INFUSION ORDER",IVMN)=""
  1.  . K ^ORD(101.41,"C",IVODSP,IVMN)
  1.  Q
  1.  ;
  1. SENDDLG(ANAME) ; Return true if the current order dialog should be sent
  1.  ; New dialogs for Outpatient Meals:
  1.  I ANAME="FHW OP MEAL" Q 1
  1.  I ANAME="FHW SPECIAL MEAL" Q 1
  1.  I ANAME="FHW2" Q 1
  1.  I ANAME="FHW7" Q 1
  1.  I ANAME="FHW8" Q 1
  1.  I ANAME="OR GTX VISITSTR" Q 1
  1.  I ANAME="OR GTX DELIVERY" Q 1
  1.  I ANAME="OR GTX DATE/TIME" Q 1
  1.  I ANAME="OR GTX MEAL DATE" Q 1
  1.  I ANAME="OR GTX ADDL DIETS" Q 1
  1.  I ANAME="PSH OERR" Q 1
  1.  ; Update IV Dialog
  1.  I ANAME="PSJI OR PAT FLUID OE" Q 1
  1.  I ANAME="RA OERR EXAM" Q 1
  1.  I ANAME="LR OTHER LAB TESTS" Q 1
  1.  Q 0
  1.  ;
  1. SETFHPRT ;       Set Outpt Meals print formats
  1.  N VAL,PKG
  1.  S PKG="DIETETICS"
  1.  S VAL=$O(^ORD(100.23,"B","FH OUTPT MEAL TICKET",0))
  1.  D EN^XPAR("SYS","ORPF WARD REQUISITION FORMAT",PKG,VAL)
  1.  S VAL=$O(^ORD(100.23,"B","FH OUTPT MEAL HEADER",0))
  1.  D EN^XPAR("SYS","ORPF WARD REQUISITION HEADER",PKG,VAL)
  1.  S VAL=$O(^ORD(100.23,"B","FH OUTPT MEAL FOOTER",0))
  1.  D EN^XPAR("SYS","ORPF WARD REQUISITION FOOTER",PKG,VAL)
  1.  Q
  1.  ;
  1. VERSION ;;26.66
  1.  ;
  1. NOTIF ; DO NOT REMOVE WITH VBECS - rename notif 47 (MEDICATIONS EXPIRING)
  1.  S $P(^ORD(100.9,47,0),U)="MEDICATIONS EXPIRING - INPT"
  1.  K ^ORD(100.9,"B")
  1.  S DIK="^ORD(100.9,",DIK(1)=".01^B" D ENALL^DIK
  1.  K DIK
  1.  Q
  1.  ;
  1. PARAM ; DO NOT REMOVE WITH VBECS - main (initial) parameter transport routine
  1.  K ^TMP($J,"XPARRSTR")
  1.  N ENT,IDX,ROOT,REF,VAL,I
  1.  S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","  ;DBIA 2336
  1.  D LOAD
  1. XX2 S IDX=0,ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING"
  1.  F  S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX  D
  1.  . N PAR,INST,ORVAL,ORERR K ORVAL
  1.  . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
  1.  . M ORVAL=^TMP($J,"XPARRSTR",IDX,"VAL")
  1.  . D EN^XPAR(ENT,PAR,INST,.ORVAL,.ORERR)  ;DBIA 2336
  1.  K ^TMP($J,"XPARRSTR")
  1.  Q
  1. LOAD ; load data into ^TMP (expects ROOT to be defined)
  1.  S I=1 F  S REF=$T(DATA+I) Q:REF=""  S VAL=$T(DATA+I+1) D
  1.  . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
  1.  . S @(ROOT_REF)=VAL
  1.  Q
  1. BULLMG ;
  1.  N MGIEN,FDA,ORERR
  1.  S MGIEN=$$FIND1^DIC(3.8,,"MX","OR DRUG ORDER CANCELLED")
  1.  S FDA(3.6,"?1,",.01)="OR DRUG ORDER CANCELLED"
  1.  S FDA(3.62,"+2,?1,",.01)="OR DRUG ORDER CANCELLED"
  1.  D UPDATE^DIE("E","FDA","",.ORERR)
  1.  Q
  1. DATA ; parameter data
  1.  ;;7240,"KEY")
  1.  ;;ORB ARCHIVE PERIOD^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7240,"VAL")
  1.  ;;30
  1.  ;;7241,"KEY")
  1.  ;;ORB DELETE MECHANISM^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7241,"VAL")
  1.  ;;All Recipients
  1.  ;;7242,"KEY")
  1.  ;;ORB FORWARD BACKUP REVIEWER^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7242,"VAL")
  1.  ;;0
  1.  ;;7243,"KEY")
  1.  ;;ORB FORWARD SUPERVISOR^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7243,"VAL")
  1.  ;;0
  1.  ;;7244,"KEY")
  1.  ;;ORB FORWARD SURROGATES^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7244,"VAL")
  1.  ;;0
  1.  ;;7245,"KEY")
  1.  ;;ORB PROCESSING FLAG^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7245,"VAL")
  1.  ;;Disabled
  1.  ;;7246,"KEY")
  1.  ;;ORB PROVIDER RECIPIENTS^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7246,"VAL")
  1.  ;;OAPT
  1.  ;;7247,"KEY")
  1.  ;;ORB URGENCY^MEDICATIONS EXPIRING - OUTPT
  1.  ;;7247,"VAL")
  1.  ;;High
  1.  ;;6064,"KEY")
  1.  ;;ORWOR EXPIRED ORDERS^1
  1.  ;;6064,"VAL")
  1.  ;;72