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