ORY148 ;SLC/PKS -- postinit rtn for OR*3*148 ;6/21/02 12:04 [7/23/02 2:15pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**148**;Dec 17, 1997
;
Q
;
PRE ; -- preinit
;
Q
;
POST ; -- postinit
;
N VER,ORCOUNT
;
S VER=$P($T(VERSION^ORY148),";",3)
D USERSET
D PAROUT
I +$$PATCH^XPDUTL("TIU*1.0*109") D CPREG
I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
D MAIL
;
Q
;
USERSET ; Queue background task to set user default settings.
;
N ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK
;
S ZTRTN="DQSET^ORY148",ZTDESC="OR*3*148 Post Install",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H
D ^%ZTLOAD
I $G(ZTSK) D MES^XPDUTL("User defaults for OR*3*148 queued as task number "_ZTSK_".")
I '$G(ZTSK) D MES^XPDUTL("User defaults task did not queue")
;
Q
;
DQSET ; Queue background task to set user default settings.
;
S ORCOUNT=0
S ^TMP("ORY148",$J,1)="Background task for OR*3*148 has completed."
S ^TMP("ORY148",$J,2)=" "
S ^TMP("ORY148",$J,3)="The following problems were encountered:"
S ^TMP("ORY148",$J,4)=" "
S ORCOUNT=4
;
; Set user default settings:
D DEFTABS
I ORCOUNT=4 S ^TMP("ORY148",$J,5)="No problems encountered."
;
; Send message with results to user, postmaster:
N XMSUB,XMTEXT,SMDUZ,SMY
S XMSUB="Patch OR*3*148 Post-Install Complete" ; Message subject.
S XMDUZ="Patch OR*3*148 Post Install" ; Message "from."
S XMY(.5)="" S:$G(DUZ) XMY(DUZ)="" ; To user,postmaster.
S XMTEXT="^TMP(""ORY148"",$J," ; Text for message.
D ^XMD
K ^TMP("ORY148",$J)
;
Q
;
DEFTABS ; Default tab, restricted patient list entries for GUI users.
;
N ORZ,ORZZ,OROPT,ORUSER,DIE
;
S OROPT="OR CPRS GUI CHART"
S OROPT=$$OPTLK^XQCS(OROPT)
S OROPT=+OROPT
I OROPT<1 D Q
.W !,"No OR CPRS GUI CHART Option found!"
;
; Establish loop to order through users:
S ORUSER=0
F S ORUSER=$O(^VA(200,ORUSER)) Q:'ORUSER>0 D
.S ORZ=0
.S ORZ=$$ACCESS^XQCHK(ORUSER,OROPT) ; Have OR CPRS GUI CHART option?
.S ORZ=+ORZ
.S ORZZ=$G(^VA(200,ORUSER,0))
.S ORZZ=$P(ORZZ,U,4)
.I ((ORZ>0)!(ORZZ["@")) D
..;
..; Set default of "COR" for CPRS tabs multiple:
..N ORFDA,ORIEN,ORERR
..S ORIEN(1)=ORUSER
..S ORFDA(200.010113,"+2,"_ORUSER_",",.01)=1
..S ORFDA(200.010113,"+2,"_ORUSER_",",.02)=DT
..I ('$D(^VA(200,ORUSER,"ORD",0))) D UPDATE^DIE("","ORFDA","ORIEN","ORERR")
..I $D(ORERR) D
...;
...; Send installation error message to run under Taskman:
...S ORCOUNT=ORCOUNT+1
...S ^TMP("ORY148",$J,ORCOUNT)="Could not create default COR Tab entry for user "_ORUSER_"."
..;
..; Set default of "N" for restricted patient list field:
..N ORFDA,ORIEN,ORERR
..S ORIEN(1)=ORUSER
..S ORFDA(200,ORUSER_",",101.01)=0
..I ('$D(^VA(200,ORUSER,101))) D UPDATE^DIE("","ORFDA","ORIEN","ORERR")
..I $D(ORERR) D
...;
...; Send installation error message to run under Taskman:
...S ORCOUNT=ORCOUNT+1
...S ^TMP("ORY148",$J,ORCOUNT)="Could not make RPL default NO entry for user "_ORUSER_"."
..;
..D CLEAN^DILF ; Clean up after DB call.
;
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
;
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
;
PAROUT ; Remove entries, parameter "ORWT TOOLS RPT SETTINGS OFF" if found.
;
; Remove all instances of parameter:
N DA,DIK,PAR,ENT,INST,DIRUT,DUOUT,DTOUT,ORIEN
S PAR="ORWT TOOLS RPT SETTINGS OFF"
;
S ORIEN=0
S ORIEN=$O(^XTV(8989.51,"B",PAR,ORIEN))
S ORIEN=+ORIEN
I 'ORIEN Q
;
S ENT=0
F S ENT=$O(^XTV(8989.5,"AC",ORIEN,ENT)) Q:'ENT D
.S INST=0
.F S INST=$O(^XTV(8989.5,"AC",ORIEN,ENT,INST)) Q:INST="" D Q
..D DEL^XPAR(ENT,ORIEN,INST)
;
; Remove parameter definition itself:
S DIK="^XTV(8989.51,"
S DA=ORIEN
D ^DIK
;
Q
;
LINE(DATA) ; set text into array
S COUNT=COUNT+1
S TEXT(COUNT)=DATA
Q
;
VERSION ;;19.15
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY148 4983 printed Apr 09, 2024@21:32:54 Page 2
ORY148 ;SLC/PKS -- postinit rtn for OR*3*148 ;6/21/02 12:04 [7/23/02 2:15pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**148**;Dec 17, 1997
+2 ;
+3 QUIT
+4 ;
PRE ; -- preinit
+1 ;
+2 QUIT
+3 ;
POST ; -- postinit
+1 ;
+2 NEW VER,ORCOUNT
+3 ;
+4 SET VER=$PIECE($TEXT(VERSION^ORY148),";",3)
+5 DO USERSET
+6 DO PAROUT
+7 IF +$$PATCH^XPDUTL("TIU*1.0*109")
DO CPREG
+8 IF +$$PATCH^XPDUTL("TIU*1.0*112")
DO SURGREG
+9 DO MAIL
+10 ;
+11 QUIT
+12 ;
USERSET ; Queue background task to set user default settings.
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK
+3 ;
+4 SET ZTRTN="DQSET^ORY148"
SET ZTDESC="OR*3*148 Post Install"
SET ZTIO=""
SET ZTSAVE("DUZ")=""
SET ZTDTH=$HOROLOG
+5 DO ^%ZTLOAD
+6 IF $GET(ZTSK)
DO MES^XPDUTL("User defaults for OR*3*148 queued as task number "_ZTSK_".")
+7 IF '$GET(ZTSK)
DO MES^XPDUTL("User defaults task did not queue")
+8 ;
+9 QUIT
+10 ;
DQSET ; Queue background task to set user default settings.
+1 ;
+2 SET ORCOUNT=0
+3 SET ^TMP("ORY148",$JOB,1)="Background task for OR*3*148 has completed."
+4 SET ^TMP("ORY148",$JOB,2)=" "
+5 SET ^TMP("ORY148",$JOB,3)="The following problems were encountered:"
+6 SET ^TMP("ORY148",$JOB,4)=" "
+7 SET ORCOUNT=4
+8 ;
+9 ; Set user default settings:
+10 DO DEFTABS
+11 IF ORCOUNT=4
SET ^TMP("ORY148",$JOB,5)="No problems encountered."
+12 ;
+13 ; Send message with results to user, postmaster:
+14 NEW XMSUB,XMTEXT,SMDUZ,SMY
+15 ; Message subject.
SET XMSUB="Patch OR*3*148 Post-Install Complete"
+16 ; Message "from."
SET XMDUZ="Patch OR*3*148 Post Install"
+17 ; To user,postmaster.
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+18 ; Text for message.
SET XMTEXT="^TMP(""ORY148"",$J,"
+19 DO ^XMD
+20 KILL ^TMP("ORY148",$JOB)
+21 ;
+22 QUIT
+23 ;
DEFTABS ; Default tab, restricted patient list entries for GUI users.
+1 ;
+2 NEW ORZ,ORZZ,OROPT,ORUSER,DIE
+3 ;
+4 SET OROPT="OR CPRS GUI CHART"
+5 SET OROPT=$$OPTLK^XQCS(OROPT)
+6 SET OROPT=+OROPT
+7 IF OROPT<1
Begin DoDot:1
+8 WRITE !,"No OR CPRS GUI CHART Option found!"
End DoDot:1
QUIT
+9 ;
+10 ; Establish loop to order through users:
+11 SET ORUSER=0
+12 FOR
SET ORUSER=$ORDER(^VA(200,ORUSER))
if 'ORUSER>0
QUIT
Begin DoDot:1
+13 SET ORZ=0
+14 ; Have OR CPRS GUI CHART option?
SET ORZ=$$ACCESS^XQCHK(ORUSER,OROPT)
+15 SET ORZ=+ORZ
+16 SET ORZZ=$GET(^VA(200,ORUSER,0))
+17 SET ORZZ=$PIECE(ORZZ,U,4)
+18 IF ((ORZ>0)!(ORZZ["@"))
Begin DoDot:2
+19 ;
+20 ; Set default of "COR" for CPRS tabs multiple:
+21 NEW ORFDA,ORIEN,ORERR
+22 SET ORIEN(1)=ORUSER
+23 SET ORFDA(200.010113,"+2,"_ORUSER_",",.01)=1
+24 SET ORFDA(200.010113,"+2,"_ORUSER_",",.02)=DT
+25 IF ('$DATA(^VA(200,ORUSER,"ORD",0)))
DO UPDATE^DIE("","ORFDA","ORIEN","ORERR")
+26 IF $DATA(ORERR)
Begin DoDot:3
+27 ;
+28 ; Send installation error message to run under Taskman:
+29 SET ORCOUNT=ORCOUNT+1
+30 SET ^TMP("ORY148",$JOB,ORCOUNT)="Could not create default COR Tab entry for user "_ORUSER_"."
End DoDot:3
+31 ;
+32 ; Set default of "N" for restricted patient list field:
+33 NEW ORFDA,ORIEN,ORERR
+34 SET ORIEN(1)=ORUSER
+35 SET ORFDA(200,ORUSER_",",101.01)=0
+36 IF ('$DATA(^VA(200,ORUSER,101)))
DO UPDATE^DIE("","ORFDA","ORIEN","ORERR")
+37 IF $DATA(ORERR)
Begin DoDot:3
+38 ;
+39 ; Send installation error message to run under Taskman:
+40 SET ORCOUNT=ORCOUNT+1
+41 SET ^TMP("ORY148",$JOB,ORCOUNT)="Could not make RPL default NO entry for user "_ORUSER_"."
End DoDot:3
+42 ;
+43 ; Clean up after DB call.
DO CLEAN^DILF
End DoDot:2
End DoDot:1
+44 ;
+45 QUIT
+46 ;
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 ;
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 ;
PAROUT ; Remove entries, parameter "ORWT TOOLS RPT SETTINGS OFF" if found.
+1 ;
+2 ; Remove all instances of parameter:
+3 NEW DA,DIK,PAR,ENT,INST,DIRUT,DUOUT,DTOUT,ORIEN
+4 SET PAR="ORWT TOOLS RPT SETTINGS OFF"
+5 ;
+6 SET ORIEN=0
+7 SET ORIEN=$ORDER(^XTV(8989.51,"B",PAR,ORIEN))
+8 SET ORIEN=+ORIEN
+9 IF 'ORIEN
QUIT
+10 ;
+11 SET ENT=0
+12 FOR
SET ENT=$ORDER(^XTV(8989.5,"AC",ORIEN,ENT))
if 'ENT
QUIT
Begin DoDot:1
+13 SET INST=0
+14 FOR
SET INST=$ORDER(^XTV(8989.5,"AC",ORIEN,ENT,INST))
if INST=""
QUIT
Begin DoDot:2
+15 DO DEL^XPAR(ENT,ORIEN,INST)
End DoDot:2
QUIT
End DoDot:1
+16 ;
+17 ; Remove parameter definition itself:
+18 SET DIK="^XTV(8989.51,"
+19 SET DA=ORIEN
+20 DO ^DIK
+21 ;
+22 QUIT
+23 ;
LINE(DATA) ; set text into array
+1 SET COUNT=COUNT+1
+2 SET TEXT(COUNT)=DATA
+3 QUIT
+4 ;
VERSION ;;19.15
