ORY132 ;SLC/REV -- postinit rtn for OR*3*132 ;12/13/01 06:25 [4/29/02 4:53pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**132**;Dec 17, 1997
;
Q
;
PRE ; -- preinit
Q
;
POST ; -- postinit
N VER
S VER=$P($T(VERSION^ORY132),";",3)
I +$$PATCH^XPDUTL("TIU*1.0*109") D CPREG
I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
D SURGRPT
D SETVAL
D TASKJOB
D MAIL
;
Q
;
TASKJOB ; Queue background task to update Order file for Alert Results field.
;
N ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK
;
S ZTRTN="FIXALERT^ORY132",ZTDESC="OR*3*132 Post Install",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H
D ^%ZTLOAD
I $G(ZTSK) D MES^XPDUTL("Order file update for OR*3*132 queued as task number "_ZTSK_".")
I '$G(ZTSK) D MES^XPDUTL("Order file update task did not queue")
;
Q
;
SETVAL ;
N ORP,ORT
S ORP="ORWRP REPORT LIST",ORT=$O(^ORD(101.24,"B","ORRPW DOD",0))
I ORT D PUT^XPAR("PKG",ORP,8,ORT)
Q
CPREG ; Register TIU Clinical Procedures RPCs if TIU*1.0*109 present
N MENU,RPC
S MENU="OR CPRS GUI CHART"
F RPC="TIU IS THIS A CLINPROC?","TIU IDENTIFY CLINPROC CLASS","TIU LONG LIST CLINPROC TITLES" D INSERT(MENU,RPC)
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" 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
;
SURGRPT ; Add Surgery report to Reports tab
N ORSURG,ORI,ORP,ORT,ORS,ORLST,ORERR,FOUND
S ORP="ORWRP REPORT LIST",ORT=$O(^ORD(101.24,"B","ORRP SURGERIES",0))
S ORSURG=$O(^ORD(101.24,"B","ORRP SURGERIES",0)),ORI=0,FOUND=0
D GETLST^XPAR(.ORLST,"PKG","ORWRP REPORT LIST","Q",.ORERR)
F S ORI=$O(ORLST(ORI)) Q:+ORI=0!(FOUND) D
. I $P(ORLST(ORI),U,2)=ORSURG S FOUND=1
Q:+FOUND
S ORS=+ORLST(ORLST)+5
D PUT^XPAR("PKG",ORP,ORS,ORT)
Q
;
FIXALERT ; convert "1" in ALERT ON RESULTS field to Ordering Provider
N ORX,ORDUZ,ORTEXT
S ORX=0 F S ORX=$O(^OR(100,ORX)) Q:+$G(ORX)<1 D
.I $P($G(^OR(100,ORX,3)),U,10)=1 D
..S ORDUZ=$$ORDERER^ORQOR2(ORX)
..I +$G(ORDUZ)>1 S $P(^OR(100,ORX,3),U,10)=+$G(ORDUZ)
S TEXT(1)="Background task for OR*3*132 has completed."
;
; Send message to user, postmaster:
N XMSUB,XMTEXT,SMDUZ,SMY
S XMSUB="Patch OR*3*132 Tasked Post-Install Complete" ; Msg subject.
S XMDUZ="Patch OR*3*132 Tasked Post Install" ; Message "from."
S XMY(.5)="" S:$G(DUZ) XMY(DUZ)="" ; To user,postmaster.
S XMTEXT="TEXT("
D ^XMD
;
Q
;
SENDPAR(ANAME) ; Return true if the current parameter should be sent
I ANAME="ORCH INITIAL TAB" Q 1
I ANAME="ORWOR SHOW SURGERY TAB" Q 1
I ANAME="ORWOR PKI USE" Q 1
Q 0
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 ;;19.7
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY132 3542 printed Sep 23, 2025@20:14:45 Page 2
ORY132 ;SLC/REV -- postinit rtn for OR*3*132 ;12/13/01 06:25 [4/29/02 4:53pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**132**;Dec 17, 1997
+2 ;
+3 QUIT
+4 ;
PRE ; -- preinit
+1 QUIT
+2 ;
POST ; -- postinit
+1 NEW VER
+2 SET VER=$PIECE($TEXT(VERSION^ORY132),";",3)
+3 IF +$$PATCH^XPDUTL("TIU*1.0*109")
DO CPREG
+4 IF +$$PATCH^XPDUTL("TIU*1.0*112")
DO SURGREG
+5 DO SURGRPT
+6 DO SETVAL
+7 DO TASKJOB
+8 DO MAIL
+9 ;
+10 QUIT
+11 ;
TASKJOB ; Queue background task to update Order file for Alert Results field.
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK
+3 ;
+4 SET ZTRTN="FIXALERT^ORY132"
SET ZTDESC="OR*3*132 Post Install"
SET ZTIO=""
SET ZTSAVE("DUZ")=""
SET ZTDTH=$HOROLOG
+5 DO ^%ZTLOAD
+6 IF $GET(ZTSK)
DO MES^XPDUTL("Order file update for OR*3*132 queued as task number "_ZTSK_".")
+7 IF '$GET(ZTSK)
DO MES^XPDUTL("Order file update task did not queue")
+8 ;
+9 QUIT
+10 ;
SETVAL ;
+1 NEW ORP,ORT
+2 SET ORP="ORWRP REPORT LIST"
SET ORT=$ORDER(^ORD(101.24,"B","ORRPW DOD",0))
+3 IF ORT
DO PUT^XPAR("PKG",ORP,8,ORT)
+4 QUIT
CPREG ; Register TIU Clinical Procedures RPCs if TIU*1.0*109 present
+1 NEW MENU,RPC
+2 SET MENU="OR CPRS GUI CHART"
+3 FOR RPC="TIU IS THIS A CLINPROC?","TIU IDENTIFY CLINPROC CLASS","TIU LONG LIST CLINPROC TITLES"
DO INSERT(MENU,RPC)
+4 QUIT
+5 ;
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"
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 ;
SURGRPT ; Add Surgery report to Reports tab
+1 NEW ORSURG,ORI,ORP,ORT,ORS,ORLST,ORERR,FOUND
+2 SET ORP="ORWRP REPORT LIST"
SET ORT=$ORDER(^ORD(101.24,"B","ORRP SURGERIES",0))
+3 SET ORSURG=$ORDER(^ORD(101.24,"B","ORRP SURGERIES",0))
SET ORI=0
SET FOUND=0
+4 DO GETLST^XPAR(.ORLST,"PKG","ORWRP REPORT LIST","Q",.ORERR)
+5 FOR
SET ORI=$ORDER(ORLST(ORI))
if +ORI=0!(FOUND)
QUIT
Begin DoDot:1
+6 IF $PIECE(ORLST(ORI),U,2)=ORSURG
SET FOUND=1
End DoDot:1
+7 if +FOUND
QUIT
+8 SET ORS=+ORLST(ORLST)+5
+9 DO PUT^XPAR("PKG",ORP,ORS,ORT)
+10 QUIT
+11 ;
FIXALERT ; convert "1" in ALERT ON RESULTS field to Ordering Provider
+1 NEW ORX,ORDUZ,ORTEXT
+2 SET ORX=0
FOR
SET ORX=$ORDER(^OR(100,ORX))
if +$GET(ORX)<1
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^OR(100,ORX,3)),U,10)=1
Begin DoDot:2
+4 SET ORDUZ=$$ORDERER^ORQOR2(ORX)
+5 IF +$GET(ORDUZ)>1
SET $PIECE(^OR(100,ORX,3),U,10)=+$GET(ORDUZ)
End DoDot:2
End DoDot:1
+6 SET TEXT(1)="Background task for OR*3*132 has completed."
+7 ;
+8 ; Send message to user, postmaster:
+9 NEW XMSUB,XMTEXT,SMDUZ,SMY
+10 ; Msg subject.
SET XMSUB="Patch OR*3*132 Tasked Post-Install Complete"
+11 ; Message "from."
SET XMDUZ="Patch OR*3*132 Tasked Post Install"
+12 ; To user,postmaster.
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+13 SET XMTEXT="TEXT("
+14 DO ^XMD
+15 ;
+16 QUIT
+17 ;
SENDPAR(ANAME) ; Return true if the current parameter should be sent
+1 IF ANAME="ORCH INITIAL TAB"
QUIT 1
+2 IF ANAME="ORWOR SHOW SURGERY TAB"
QUIT 1
+3 IF ANAME="ORWOR PKI USE"
QUIT 1
+4 QUIT 0
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 ;;19.7
