ORY190 ; slc/CLA - Pre and Post-init for patch OR*3*190 ; Aug 6, 2003@11:02:31 [6/17/04 12:59pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**190**;Dec 17, 1997
;
PRE ;initiate pre-init processes
;
Q
;
POST ;initiate post-init processes
;
N VER
;
S VER=$P($T(VERSION^ORY190),";",3)
I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
D SETVAL
D SORTCHG
D PSIV
D MAIL
;
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
;
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
;
SETVAL ; Set package-level values for params
N X
S X=0,X=$O(^ORD(100.98,"B","NON-VA MEDICATIONS",X)) Q:'X D
. D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",68,X)
S X=0,X=$O(^ORD(101.41,"B","PSH OERR",X)) Q:'X D
. D PUT^XPAR("PKG","ORWOR WRITE ORDERS LIST",53,X)
D PUT^XPAR("PKG","ORWD NONVA REASON",1,"Non-VA medication not recommended by VA provider.")
D PUT^XPAR("PKG","ORWD NONVA REASON",2,"Non-VA medication recommended by VA provider.")
D PUT^XPAR("PKG","ORWD NONVA REASON",3,"Patient wants to buy from Non-VA pharmacy.")
D PUT^XPAR("PKG","ORWD NONVA REASON",4,"Medication prescribed by Non-VA provider.")
;
D PUT^XPAR("PKG","ORB SORT METHOD",1,"D") ; Date/Time
Q
;
SORTCHG ; conver "T" sort method values to "M"
N ORLST,ORERR,ORBX,ORBE,ORBERR
S ORBE=0,ORBX=0
D ENVAL^XPAR(.ORLST,"ORB SORT METHOD",1,.ORERR)
I 'ORERR,$G(ORLST)>0 D
.F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) I ORLST(ORBE,1)="T" D
..D EN^XPAR(ORBE,"ORB SORT METHOD",1,"M",.ORBERR)
..I +ORBERR>0 D
...S X="Error: "_ORBERR_" converting ORB SORT METHOD value 'T' to 'M' for entity "_ORBE
...D BMES^XPDUTL(X)
Q
;
PSIV ; convert package ptrs in #101.41 from PSIV to PSJ
N ORPSIV,ORPSJ,ORI,X
S ORPSIV=+$$PKG^ORMPS1("PSIV"),ORPSJ=+$$PKG^ORMPS1("PSJ") Q:ORPSJ<1
S ORI=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0)) I ORI,$D(^ORD(101.41,ORI,0)) S X=$P(^(0),U,7),$P(^(0),U,7)=ORPSJ K ^ORD(101.41,"APKG",X,ORI) S ^ORD(101.41,"APKG",ORPSJ,ORI)="" ;ensure IV dlg is correct
I ORPSIV S ORI=0 F S ORI=$O(^ORD(101.41,"APKG",ORPSIV,ORI)) Q:ORI<1 D
. K ^ORD(101.41,"APKG",ORPSIV,ORI)
. S $P(^ORD(101.41,ORI,0),U,7)=ORPSJ,^ORD(101.41,"APKG",ORPSJ,ORI)=""
Q
;
MAIL ; send bulletin of installation time
N COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
S COUNT=0
S XMSUB="Version "_$P($T(VERSION),";;",2)_" Installed"
S XMDUZ="CPRS PACKAGE"
F I="G.CPRS GUI INSTALL@ISC-SLC.DOMAIN.EXT",DUZ S XMY(I)=""
S XMTEXT="TEXT("
;
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
;
LINE(DATA) ; set text into array
S COUNT=COUNT+1
S TEXT(COUNT)=DATA
Q
;
VERSION ;;24.26
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY190 3197 printed Sep 23, 2025@20:15:17 Page 2
ORY190 ; slc/CLA - Pre and Post-init for patch OR*3*190 ; Aug 6, 2003@11:02:31 [6/17/04 12:59pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190**;Dec 17, 1997
+2 ;
PRE ;initiate pre-init processes
+1 ;
+2 QUIT
+3 ;
POST ;initiate post-init processes
+1 ;
+2 NEW VER
+3 ;
+4 SET VER=$PIECE($TEXT(VERSION^ORY190),";",3)
+5 IF +$$PATCH^XPDUTL("TIU*1.0*112")
DO SURGREG
+6 DO SETVAL
+7 DO SORTCHG
+8 DO PSIV
+9 DO MAIL
+10 ;
+11 QUIT
+12 ;
SURGREG ; Register TIU SURGERY RPCs if TIU*1.0*112 present
+1 NEW MENU,RPC
+2 SET MENU="OR CPRS GUI CHART"
+3 FOR RPC="TIU IS THIS A SURGERY?","TIU IDENTIFY SURGERY CLASS","TIU LONG LIST SURGERY TITLES","TIU GET DOCUMENTS FOR REQUEST"
DO INSERT(MENU,RPC)
+4 QUIT
+5 ;
INSERT(OPTION,RPC) ; Call FM Updater with each RPC
+1 ; Input -- OPTION Option file (#19) Name field (#.01)
+2 ; RPC RPC sub-file (#19.05) RPC field (#.01)
+3 ; Output -- None
+4 NEW FDA,FDAIEN,ERR,DIERR
+5 SET FDA(19,"?1,",.01)=OPTION
+6 SET FDA(19.05,"?+2,?1,",.01)=RPC
+7 DO UPDATE^DIE("E","FDA","FDAIEN","ERR")
+8 QUIT
+9 ;
SETVAL ; Set package-level values for params
+1 NEW X
+2 SET X=0
SET X=$ORDER(^ORD(100.98,"B","NON-VA MEDICATIONS",X))
if 'X
QUIT
Begin DoDot:1
+3 DO PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",68,X)
End DoDot:1
+4 SET X=0
SET X=$ORDER(^ORD(101.41,"B","PSH OERR",X))
if 'X
QUIT
Begin DoDot:1
+5 DO PUT^XPAR("PKG","ORWOR WRITE ORDERS LIST",53,X)
End DoDot:1
+6 DO PUT^XPAR("PKG","ORWD NONVA REASON",1,"Non-VA medication not recommended by VA provider.")
+7 DO PUT^XPAR("PKG","ORWD NONVA REASON",2,"Non-VA medication recommended by VA provider.")
+8 DO PUT^XPAR("PKG","ORWD NONVA REASON",3,"Patient wants to buy from Non-VA pharmacy.")
+9 DO PUT^XPAR("PKG","ORWD NONVA REASON",4,"Medication prescribed by Non-VA provider.")
+10 ;
+11 ; Date/Time
DO PUT^XPAR("PKG","ORB SORT METHOD",1,"D")
+12 QUIT
+13 ;
SORTCHG ; conver "T" sort method values to "M"
+1 NEW ORLST,ORERR,ORBX,ORBE,ORBERR
+2 SET ORBE=0
SET ORBX=0
+3 DO ENVAL^XPAR(.ORLST,"ORB SORT METHOD",1,.ORERR)
+4 IF 'ORERR
IF $GET(ORLST)>0
Begin DoDot:1
+5 FOR ORBX=1:1:ORLST
SET ORBE=$ORDER(ORLST(ORBE))
IF ORLST(ORBE,1)="T"
Begin DoDot:2
+6 DO EN^XPAR(ORBE,"ORB SORT METHOD",1,"M",.ORBERR)
+7 IF +ORBERR>0
Begin DoDot:3
+8 SET X="Error: "_ORBERR_" converting ORB SORT METHOD value 'T' to 'M' for entity "_ORBE
+9 DO BMES^XPDUTL(X)
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
PSIV ; convert package ptrs in #101.41 from PSIV to PSJ
+1 NEW ORPSIV,ORPSJ,ORI,X
+2 SET ORPSIV=+$$PKG^ORMPS1("PSIV")
SET ORPSJ=+$$PKG^ORMPS1("PSJ")
if ORPSJ<1
QUIT
+3 ;ensure IV dlg is correct
SET ORI=$ORDER(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0))
IF ORI
IF $DATA(^ORD(101.41,ORI,0))
SET X=$PIECE(^(0),U,7)
SET $PIECE(^(0),U,7)=ORPSJ
KILL ^ORD(101.41,"APKG",X,ORI)
SET ^ORD(101.41,"APKG",ORPSJ,ORI)=""
+4 IF ORPSIV
SET ORI=0
FOR
SET ORI=$ORDER(^ORD(101.41,"APKG",ORPSIV,ORI))
if ORI<1
QUIT
Begin DoDot:1
+5 KILL ^ORD(101.41,"APKG",ORPSIV,ORI)
+6 SET $PIECE(^ORD(101.41,ORI,0),U,7)=ORPSJ
SET ^ORD(101.41,"APKG",ORPSJ,ORI)=""
End DoDot:1
+7 QUIT
+8 ;
MAIL ; send bulletin of installation time
+1 NEW COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
+2 SET COUNT=0
+3 SET XMSUB="Version "_$PIECE($TEXT(VERSION),";;",2)_" Installed"
+4 SET XMDUZ="CPRS PACKAGE"
+5 FOR I="G.CPRS GUI INSTALL@ISC-SLC.DOMAIN.EXT",DUZ
SET XMY(I)=""
+6 SET XMTEXT="TEXT("
+7 ;
+8 SET X=$PIECE($TEXT(VERSION),";;",2)
+9 DO LINE("Version "_X_" has been installed.")
+10 DO LINE(" ")
+11 DO LINE("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT()))
+12 ;
+13 DO ^XMD
+14 QUIT
+15 ;
LINE(DATA) ; set text into array
+1 SET COUNT=COUNT+1
+2 SET TEXT(COUNT)=DATA
+3 QUIT
+4 ;
VERSION ;;24.26
