GMRC124P ;ABV/BL - Patch 124 Post-install;03/28/2019
;;3.0;CONSULT/REQUEST TRACKING;**124**;MAR 28, 2019;Build 31
;
EN ; Entry point for post install
;
N FDA ; -- FileMan Data Array
N WEBVICE ; -- Web Service Internal Entry Number
N WEBVER ; -- Web Server Internal Entry Number
N MULTIEN ; -- Web Service Multiple Internal Entry Number
N WSTAT ; -- Web Service Status
N IENROOT,MSGROOT,IENROOT1,VICEIEN
;
K FDA
S WEBVICE=$O(^XOB(18.02,"B","DST GET ID SERVICE",0))
S WEBVICE=$S(WEBVICE:WEBVICE,1:"+1")
S FDA(18.02,WEBVICE_",",.01)="DST GET ID SERVICE" ; NAME
S FDA(18.02,WEBVICE_",",.02)="REST" ; TYPE
S FDA(18.02,WEBVICE_",",200)="vs/v1/consultFactor" ; CONTEXT ROOT
D UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
K IENROOT,MSGROOT,FDA
;
S WEBVER=$O(^XOB(18.12,"B","DST GET ID SERVER",0))
S WEBVER=$S(WEBVER:WEBVER,1:"+1")
S FDA(18.12,WEBVER_",",.01)="DST GET ID SERVER" ; NAME
S FDA(18.12,WEBVER_",",.03)="80" ; PORT
S FDA(18.12,WEBVER_",",.04)="dst.domain.ext" ; SERVER
S FDA(18.12,WEBVER_",",.06)="ENABLED" ; STATUS 1-ENABLED / 0-DISABLED
S FDA(18.12,WEBVER_",",.07)=60 ; DEFAULT HTTP TIMEOUT
S FDA(18.12,WEBVER_",",1.01)="NO" ; LOGIN REQUIRED
S FDA(18.12,WEBVER_",",3.01)="TRUE" ; SSL ENABLED
S FDA(18.12,WEBVER_",",3.02)="encrypt_only_all" ; SSL CONFIGURATION
S FDA(18.12,WEBVER_",",3.03)="443" ; SSL PORT
;Need to determine if we are creating a new file, or updating an existing one
N NEW
S NEW=1
I $D(^XOB(18.12,WEBVER,0)) S NEW=0
I NEW=1 D
. D UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
I NEW=0 D
. D FILE^DIE("E","FDA","MSGROOT")
;
;
S IENROOT1=$G(IENROOT(1)),MULTIEN=0
;
S WEBVER=$S(IENROOT1:IENROOT1,1:WEBVER)
K IENROOT,MSGROOT,FDA
S VICEIEN=0 F S VICEIEN=$O(^XOB(18.12,WEBVER,100,"B",VICEIEN)) Q:'VICEIEN I $$GET1^DIQ(18.02,VICEIEN,.01)="DST GET ID SERVICE" S MULTIEN=VICEIEN Q
S MULTIEN=$S(MULTIEN:MULTIEN,1:"+1")
S FDA(18.121,MULTIEN_","_WEBVER_",",.01)="DST GET ID SERVICE" ; WEB SERVICE
S FDA(18.121,MULTIEN_","_WEBVER_",",.06)="ENABLED" ; STATUS 1-ENABLED / 0-DISABLED
D UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
;
SPROT ;Set protocol GMRC SIGNED CONSULT DST as an item on OR EVSEND GMRC
;
N GMRDGIEN,GMRERR,GMREXIT,GMRFDA,GMRIEN,GMRRTCL,J,PRTCLITM,V,X,Y
;
D MES^XPDUTL($T(+0)_" post-init routine started "_$$HTE^XLFDT($H))
S V=$$SVDATA D MES^XPDUTL("Old data saved in "_V)
S GMRRTCL="GMRC SIGNED CONSULT DST",GMRIEN=$O(^ORD(101,"B",GMRRTCL,0))
; protocol missing, write message and exit
I '(GMRIEN>0) D MES^XPDUTL(GMRRTCL_" protocol not found. It must be installed to proceed.") Q
;
S Y="OR EVSEND GMRC",GMRDGIEN=$O(^ORD(101,"B",Y,0))
; protocol missing, write message and exit
I '(GMRDGIEN>0) D MES^XPDUTL(Y_" protocol not found. No ITEM update performed.") Q
; make OR EVSEND GMRC an extended action
S GMRFDA(101,GMRDGIEN_",",4)="X"
D UPDATE^DIE("","GMRFDA","","GMRERR")
I $D(GMRERR) D Q ; something went wrong
. D MES^XPDUTL("FileMan error when editing OR EVSEND GMRC protocol")
. N V S V="GMRERR" F S V=$Q(@V) Q:V="" D MES^XPDUTL(V_" = "_@V)
;
; is protocol already an item?
S GMREXIT=$O(^ORD(101,GMRDGIEN,10,"B",GMRIEN,0))
I GMREXIT D MES^XPDUTL(GMRRTCL_" already an ITEM in "_Y_". No update needed.") Q
;
; add protocol as ITEM
K GMRFDA,GMRERR
S GMRFDA(101.01,"+1,"_GMRDGIEN_",",.01)=GMRIEN
D UPDATE^DIE("","GMRFDA","PRTCLITM","GMRERR")
I $D(GMRERR) D Q ; something went wrong
.D MES^XPDUTL("FileMan error when adding ITEM to OR EVSEND GMRC protocol")
.N V S V="GMRERR" F S V=$Q(@V) Q:V="" D MES^XPDUTL(V_" = "_@V)
; new ITEM sub-file IEN will be in PRTCLITM(1)
D MES^XPDUTL(GMRRTCL_" protocol update finished "_$$HTE^XLFDT($H))
;
Q
;
SVDATA() ; extrinsic variable, save original FileMan data, returns storage node
;
D DT^DICRW
N FMERRCNT,GMRXTMP,GMRIEN,LN,NTRY,TXT,V,X,Y
S Y=$$NOW^XLFDT,GMRXTMP=$NA(^XTMP("GMR INSTALL LOG",Y)) ; XTMP storage location
; ^XTMP log data expires in 90 days
S X=$G(@GMRXTMP@(0)) S:X="" @GMRXTMP@(0)=$$FMADD^XLFDT(DT,90)_U_Y_"^GMR installation "_$$FMTE^XLFDT(Y)
;
S FMERRCNT=0 ; FileMan error counter
; save entries in FileMan items list
F LN=1:1 S TXT=$P($T(FMITMS+LN),";;",2,99) Q:TXT="" D
.N FLNO,FMARRY,FMERR ; file #, FileMan returned value and error message arrays
.S FLNO=+$P(TXT,U),X=$P(TXT,U,2,99) ; file number and target entry
.Q:'(FLNO>1)!(X="") ; file and entry required
.S GMRIEN=$$FIND1^DIC(FLNO,"","",X,"","","FMERR") ; lookup value in X is external format
.I $D(FMERR) D Q ; log error message and quit
..S V="FMERR",FMERRCNT=FMERRCNT+1 F S V=$Q(@V) Q:V="" S @GMRXTMP@("FM LOOKUP ERROR",FMERRCNT,V)=@V
.;
.S:'(GMRIEN>0) FMERRCNT=FMERRCNT+1,@GMRXTMP@("FM ENTRY NOT FOUND",FMERRCNT)=TXT ; entry
.S:GMRIEN>0 @GMRXTMP@("ENTRY",FLNO,GMRIEN)="entry found"
.K FMERR ; just in case
.D GETS^DIQ(FLNO,GMRIEN_",","**","EN","FMARRY","FMERR") ; data including sub-files, ignore null values
.I $D(FMERR) D ; log error message
..S V="FMERR",FMERRCNT=FMERRCNT+1 F S V=$Q(@V) Q:V="" S @GMRXTMP@("FM DATA ERROR",FMERRCNT,V)=@V
.; save the data
.M @GMRXTMP@("ENTRY")=FMARRY
;
Q GMRXTMP ; return ^XTMP storage location
;
FMITMS ; list of FileMan entries: "file # ^ .01 field value"
;;101^OR EVSEND GMRC
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRC124P 5730 printed Apr 09, 2024@20:51:07 Page 2
GMRC124P ;ABV/BL - Patch 124 Post-install;03/28/2019
+1 ;;3.0;CONSULT/REQUEST TRACKING;**124**;MAR 28, 2019;Build 31
+2 ;
EN ; Entry point for post install
+1 ;
+2 ; -- FileMan Data Array
NEW FDA
+3 ; -- Web Service Internal Entry Number
NEW WEBVICE
+4 ; -- Web Server Internal Entry Number
NEW WEBVER
+5 ; -- Web Service Multiple Internal Entry Number
NEW MULTIEN
+6 ; -- Web Service Status
NEW WSTAT
+7 NEW IENROOT,MSGROOT,IENROOT1,VICEIEN
+8 ;
+9 KILL FDA
+10 SET WEBVICE=$ORDER(^XOB(18.02,"B","DST GET ID SERVICE",0))
+11 SET WEBVICE=$SELECT(WEBVICE:WEBVICE,1:"+1")
+12 ; NAME
SET FDA(18.02,WEBVICE_",",.01)="DST GET ID SERVICE"
+13 ; TYPE
SET FDA(18.02,WEBVICE_",",.02)="REST"
+14 ; CONTEXT ROOT
SET FDA(18.02,WEBVICE_",",200)="vs/v1/consultFactor"
+15 DO UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
+16 KILL IENROOT,MSGROOT,FDA
+17 ;
+18 SET WEBVER=$ORDER(^XOB(18.12,"B","DST GET ID SERVER",0))
+19 SET WEBVER=$SELECT(WEBVER:WEBVER,1:"+1")
+20 ; NAME
SET FDA(18.12,WEBVER_",",.01)="DST GET ID SERVER"
+21 ; PORT
SET FDA(18.12,WEBVER_",",.03)="80"
+22 ; SERVER
SET FDA(18.12,WEBVER_",",.04)="dst.domain.ext"
+23 ; STATUS 1-ENABLED / 0-DISABLED
SET FDA(18.12,WEBVER_",",.06)="ENABLED"
+24 ; DEFAULT HTTP TIMEOUT
SET FDA(18.12,WEBVER_",",.07)=60
+25 ; LOGIN REQUIRED
SET FDA(18.12,WEBVER_",",1.01)="NO"
+26 ; SSL ENABLED
SET FDA(18.12,WEBVER_",",3.01)="TRUE"
+27 ; SSL CONFIGURATION
SET FDA(18.12,WEBVER_",",3.02)="encrypt_only_all"
+28 ; SSL PORT
SET FDA(18.12,WEBVER_",",3.03)="443"
+29 ;Need to determine if we are creating a new file, or updating an existing one
+30 NEW NEW
+31 SET NEW=1
+32 IF $DATA(^XOB(18.12,WEBVER,0))
SET NEW=0
+33 IF NEW=1
Begin DoDot:1
+34 DO UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
End DoDot:1
+35 IF NEW=0
Begin DoDot:1
+36 DO FILE^DIE("E","FDA","MSGROOT")
End DoDot:1
+37 ;
+38 ;
+39 SET IENROOT1=$GET(IENROOT(1))
SET MULTIEN=0
+40 ;
+41 SET WEBVER=$SELECT(IENROOT1:IENROOT1,1:WEBVER)
+42 KILL IENROOT,MSGROOT,FDA
+43 SET VICEIEN=0
FOR
SET VICEIEN=$ORDER(^XOB(18.12,WEBVER,100,"B",VICEIEN))
if 'VICEIEN
QUIT
IF $$GET1^DIQ(18.02,VICEIEN,.01)="DST GET ID SERVICE"
SET MULTIEN=VICEIEN
QUIT
+44 SET MULTIEN=$SELECT(MULTIEN:MULTIEN,1:"+1")
+45 ; WEB SERVICE
SET FDA(18.121,MULTIEN_","_WEBVER_",",.01)="DST GET ID SERVICE"
+46 ; STATUS 1-ENABLED / 0-DISABLED
SET FDA(18.121,MULTIEN_","_WEBVER_",",.06)="ENABLED"
+47 DO UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
+48 ;
SPROT ;Set protocol GMRC SIGNED CONSULT DST as an item on OR EVSEND GMRC
+1 ;
+2 NEW GMRDGIEN,GMRERR,GMREXIT,GMRFDA,GMRIEN,GMRRTCL,J,PRTCLITM,V,X,Y
+3 ;
+4 DO MES^XPDUTL($TEXT(+0)_" post-init routine started "_$$HTE^XLFDT($HOROLOG))
+5 SET V=$$SVDATA
DO MES^XPDUTL("Old data saved in "_V)
+6 SET GMRRTCL="GMRC SIGNED CONSULT DST"
SET GMRIEN=$ORDER(^ORD(101,"B",GMRRTCL,0))
+7 ; protocol missing, write message and exit
+8 IF '(GMRIEN>0)
DO MES^XPDUTL(GMRRTCL_" protocol not found. It must be installed to proceed.")
QUIT
+9 ;
+10 SET Y="OR EVSEND GMRC"
SET GMRDGIEN=$ORDER(^ORD(101,"B",Y,0))
+11 ; protocol missing, write message and exit
+12 IF '(GMRDGIEN>0)
DO MES^XPDUTL(Y_" protocol not found. No ITEM update performed.")
QUIT
+13 ; make OR EVSEND GMRC an extended action
+14 SET GMRFDA(101,GMRDGIEN_",",4)="X"
+15 DO UPDATE^DIE("","GMRFDA","","GMRERR")
+16 ; something went wrong
IF $DATA(GMRERR)
Begin DoDot:1
+17 DO MES^XPDUTL("FileMan error when editing OR EVSEND GMRC protocol")
+18 NEW V
SET V="GMRERR"
FOR
SET V=$QUERY(@V)
if V=""
QUIT
DO MES^XPDUTL(V_" = "_@V)
End DoDot:1
QUIT
+19 ;
+20 ; is protocol already an item?
+21 SET GMREXIT=$ORDER(^ORD(101,GMRDGIEN,10,"B",GMRIEN,0))
+22 IF GMREXIT
DO MES^XPDUTL(GMRRTCL_" already an ITEM in "_Y_". No update needed.")
QUIT
+23 ;
+24 ; add protocol as ITEM
+25 KILL GMRFDA,GMRERR
+26 SET GMRFDA(101.01,"+1,"_GMRDGIEN_",",.01)=GMRIEN
+27 DO UPDATE^DIE("","GMRFDA","PRTCLITM","GMRERR")
+28 ; something went wrong
IF $DATA(GMRERR)
Begin DoDot:1
+29 DO MES^XPDUTL("FileMan error when adding ITEM to OR EVSEND GMRC protocol")
+30 NEW V
SET V="GMRERR"
FOR
SET V=$QUERY(@V)
if V=""
QUIT
DO MES^XPDUTL(V_" = "_@V)
End DoDot:1
QUIT
+31 ; new ITEM sub-file IEN will be in PRTCLITM(1)
+32 DO MES^XPDUTL(GMRRTCL_" protocol update finished "_$$HTE^XLFDT($HOROLOG))
+33 ;
+34 QUIT
+35 ;
SVDATA() ; extrinsic variable, save original FileMan data, returns storage node
+1 ;
+2 DO DT^DICRW
+3 NEW FMERRCNT,GMRXTMP,GMRIEN,LN,NTRY,TXT,V,X,Y
+4 ; XTMP storage location
SET Y=$$NOW^XLFDT
SET GMRXTMP=$NAME(^XTMP("GMR INSTALL LOG",Y))
+5 ; ^XTMP log data expires in 90 days
+6 SET X=$GET(@GMRXTMP@(0))
if X=""
SET @GMRXTMP@(0)=$$FMADD^XLFDT(DT,90)_U_Y_"^GMR installation "_$$FMTE^XLFDT(Y)
+7 ;
+8 ; FileMan error counter
SET FMERRCNT=0
+9 ; save entries in FileMan items list
+10 FOR LN=1:1
SET TXT=$PIECE($TEXT(FMITMS+LN),";;",2,99)
if TXT=""
QUIT
Begin DoDot:1
+11 ; file #, FileMan returned value and error message arrays
NEW FLNO,FMARRY,FMERR
+12 ; file number and target entry
SET FLNO=+$PIECE(TXT,U)
SET X=$PIECE(TXT,U,2,99)
+13 ; file and entry required
if '(FLNO>1)!(X="")
QUIT
+14 ; lookup value in X is external format
SET GMRIEN=$$FIND1^DIC(FLNO,"","",X,"","","FMERR")
+15 ; log error message and quit
IF $DATA(FMERR)
Begin DoDot:2
+16 SET V="FMERR"
SET FMERRCNT=FMERRCNT+1
FOR
SET V=$QUERY(@V)
if V=""
QUIT
SET @GMRXTMP@("FM LOOKUP ERROR",FMERRCNT,V)=@V
End DoDot:2
QUIT
+17 ;
+18 ; entry
if '(GMRIEN>0)
SET FMERRCNT=FMERRCNT+1
SET @GMRXTMP@("FM ENTRY NOT FOUND",FMERRCNT)=TXT
+19 if GMRIEN>0
SET @GMRXTMP@("ENTRY",FLNO,GMRIEN)="entry found"
+20 ; just in case
KILL FMERR
+21 ; data including sub-files, ignore null values
DO GETS^DIQ(FLNO,GMRIEN_",","**","EN","FMARRY","FMERR")
+22 ; log error message
IF $DATA(FMERR)
Begin DoDot:2
+23 SET V="FMERR"
SET FMERRCNT=FMERRCNT+1
FOR
SET V=$QUERY(@V)
if V=""
QUIT
SET @GMRXTMP@("FM DATA ERROR",FMERRCNT,V)=@V
End DoDot:2
+24 ; save the data
+25 MERGE @GMRXTMP@("ENTRY")=FMARRY
End DoDot:1
+26 ;
+27 ; return ^XTMP storage location
QUIT GMRXTMP
+28 ;
FMITMS ; list of FileMan entries: "file # ^ .01 field value"
+1 ;;101^OR EVSEND GMRC
+2 ;
