source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY215.m@ 1397

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