DVBC193P ;AJF;Conversion of Request Status Field ; 8/23/18 9:55am
;;2.7;AMIE;**193**; ;Build 84
;Post conversion for patch 193
;This routine converts the Request Status field to a pointer
;IEN in file #396.33
W !!,"****************************************************"
W !,"Start Request Status Conversion"
W !,"-------------------------",!
N A,A1,A2,RO,DA,X
S A=0
F S A=$O(^DVB(396.3,A)) Q:A="" D
.Q:'$D(^DVB(396.3,A,0))
.S A1=$P(^DVB(396.3,A,0),"^",18),RO=$P(^DVB(396.3,A,0),"^",3)
.S A2=$S(A1="N":1,A1="P":2,A1="S":3,A1="R":4,A1="C":5,A1="X":6,A1="RX":7,A1="T":8,A1="NT":9,A1="CT":10,1:A1)
.S $P(^DVB(396.3,A,0),"^",18)=A2
.;Convert "AF" xref
.Q:A=""
.Q:A1=""
.S DA=A,X=A1 X ^DD(396.3,17,1,1,2)
.Q:A2=""
.S X=A2 X ^DD(396.3,17,1,1,1)
W !,"Request Status Field Update Successful",!
W !,"-------------------------"
W !,"End Request Status Conversion"
W !!,"************************************"
;
;
PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.
;
N DVBERR
;W !!,"*************************************************"
W !!,"Start DVBAB CAPRI Minimum Version Parameter Update"
W !,"-------------------------",!
;
S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*193.12*1*A*3181118")
D UPDMSG("CAPRI Minimum Version",DVBERR)
;
W !!,"-------------------------"
W !,"End DVBAB CAPRI Minimum Version Parameter Updates"
W !,"****************************************************",!!
Q
;
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;Update Parameter values
;
; Input:
; DVBENT - Parameter Entity
; DVBPAR - Parameter Name
; DVBVAL - Parameter Value
;
; Output:
; Function value - returns "0" on success;
; otherwise returns error#^errortext
;
N DVBERR
D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)
Q DVBERR
;
UPDMSG(DVBPAR,DVBERR) ;display update message
;
; Input:
; DVBPAR - Parameter Name
; DVBERR - Parameter Update result
;
; Output: none
;
I DVBERR D
. D MES^XPDUTL(DVBPAR_" update FAILURE.")
. D MES^XPDUTL(" Failure reason: "_DVBERR)
E D
. D MES^XPDUTL(DVBPAR_" Update Successful")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBC193P 2182 printed Apr 09, 2024@20:50:07 Page 2
DVBC193P ;AJF;Conversion of Request Status Field ; 8/23/18 9:55am
+1 ;;2.7;AMIE;**193**; ;Build 84
+2 ;Post conversion for patch 193
+3 ;This routine converts the Request Status field to a pointer
+4 ;IEN in file #396.33
+5 WRITE !!,"****************************************************"
+6 WRITE !,"Start Request Status Conversion"
+7 WRITE !,"-------------------------",!
+8 NEW A,A1,A2,RO,DA,X
+9 SET A=0
+10 FOR
SET A=$ORDER(^DVB(396.3,A))
if A=""
QUIT
Begin DoDot:1
+11 if '$DATA(^DVB(396.3,A,0))
QUIT
+12 SET A1=$PIECE(^DVB(396.3,A,0),"^",18)
SET RO=$PIECE(^DVB(396.3,A,0),"^",3)
+13 SET A2=$SELECT(A1="N":1,A1="P":2,A1="S":3,A1="R":4,A1="C":5,A1="X":6,A1="RX":7,A1="T":8,A1="NT":9,A1="CT":10,1:A1)
+14 SET $PIECE(^DVB(396.3,A,0),"^",18)=A2
+15 ;Convert "AF" xref
+16 if A=""
QUIT
+17 if A1=""
QUIT
+18 SET DA=A
SET X=A1
XECUTE ^DD(396.3,17,1,1,2)
+19 if A2=""
QUIT
+20 SET X=A2
XECUTE ^DD(396.3,17,1,1,1)
End DoDot:1
+21 WRITE !,"Request Status Field Update Successful",!
+22 WRITE !,"-------------------------"
+23 WRITE !,"End Request Status Conversion"
+24 WRITE !!,"************************************"
+25 ;
+26 ;
PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.
+1 ;
+2 NEW DVBERR
+3 ;W !!,"*************************************************"
+4 WRITE !!,"Start DVBAB CAPRI Minimum Version Parameter Update"
+5 WRITE !,"-------------------------",!
+6 ;
+7 SET DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*193.12*1*A*3181118")
+8 DO UPDMSG("CAPRI Minimum Version",DVBERR)
+9 ;
+10 WRITE !!,"-------------------------"
+11 WRITE !,"End DVBAB CAPRI Minimum Version Parameter Updates"
+12 WRITE !,"****************************************************",!!
+13 QUIT
+14 ;
ENXPAR(DVBENT,DVBPAR,DVBVAL) ;Update Parameter values
+1 ;
+2 ; Input:
+3 ; DVBENT - Parameter Entity
+4 ; DVBPAR - Parameter Name
+5 ; DVBVAL - Parameter Value
+6 ;
+7 ; Output:
+8 ; Function value - returns "0" on success;
+9 ; otherwise returns error#^errortext
+10 ;
+11 NEW DVBERR
+12 DO EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)
+13 QUIT DVBERR
+14 ;
UPDMSG(DVBPAR,DVBERR) ;display update message
+1 ;
+2 ; Input:
+3 ; DVBPAR - Parameter Name
+4 ; DVBERR - Parameter Update result
+5 ;
+6 ; Output: none
+7 ;
+8 IF DVBERR
Begin DoDot:1
+9 DO MES^XPDUTL(DVBPAR_" update FAILURE.")
+10 DO MES^XPDUTL(" Failure reason: "_DVBERR)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO MES^XPDUTL(DVBPAR_" Update Successful")
End DoDot:1
+13 QUIT
+14 ;
