DGBT1P35 ;ALB/KAR UPDATE FILE 8994 FOR RPCs WITH OUTPUT USED AS INPUT PARAMETERS ;1/23/19 12:04
;;1.0;Beneficiary Travel;**35**;08/28/2018;Build 18
;
;Post install routine to delete input parameters used as return variables.
Q
;
POST ; post install action
N XWBNAME,XWBRETNM
S XWBNAME="DGBT CLAIM DEDUCTIBLE PAID",XWBRETNM="DGBTRET"
D POST2(XWBNAME,XWBRETNM)
W !,"1^Successfully deleted DGBTRET in DGBT CLAIM DEDUCTIBLE PAID"
S XWBNAME="GMV PTSELECT",XWBRETNM="RESULT"
D POST2(XWBNAME,XWBRETNM)
W !,"1^Successfully deleted RESULT in GMV PTSELECT"
S XWBNAME="PSB UTL XSTATUS SRCH",XWBRETNM="RESULTS"
D POST2(XWBNAME,XWBRETNM)
W !,"1^Successfully deleted RESULTS in PSB UTL XSTATUS SRCH"
W !!,"1^All three RPCs successfully updated."
Q
;
POST2(XWBNAME,XWBRETNM) ;
N XWBI,XWBERR,XWBFDA,XWBIEN,XWBIENS
S XWBIEN=0 S XWBIEN=$O(^XWB(8994,"B",XWBNAME,XWBIEN))
S XWBI=0 F S XWBI=$O(^XWB(8994,XWBIEN,2,XWBI)) Q:'XWBI D
.I $P($G(^XWB(8994,XWBIEN,2,XWBI,0)),U)=XWBRETNM D
..S XWBIENS=XWBI_","_XWBIEN_","
..S XWBFDA(8994.02,XWBIENS,.01)="@"
..D FILE^DIE(,"XWBFDA","XWBERR") I $G(XWBERR)'="" W !,"-1^Warning! Could not update file: "_$G(XWBERR)
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBT1P35 1196 printed Dec 13, 2024@01:40:17 Page 2
DGBT1P35 ;ALB/KAR UPDATE FILE 8994 FOR RPCs WITH OUTPUT USED AS INPUT PARAMETERS ;1/23/19 12:04
+1 ;;1.0;Beneficiary Travel;**35**;08/28/2018;Build 18
+2 ;
+3 ;Post install routine to delete input parameters used as return variables.
+4 QUIT
+5 ;
POST ; post install action
+1 NEW XWBNAME,XWBRETNM
+2 SET XWBNAME="DGBT CLAIM DEDUCTIBLE PAID"
SET XWBRETNM="DGBTRET"
+3 DO POST2(XWBNAME,XWBRETNM)
+4 WRITE !,"1^Successfully deleted DGBTRET in DGBT CLAIM DEDUCTIBLE PAID"
+5 SET XWBNAME="GMV PTSELECT"
SET XWBRETNM="RESULT"
+6 DO POST2(XWBNAME,XWBRETNM)
+7 WRITE !,"1^Successfully deleted RESULT in GMV PTSELECT"
+8 SET XWBNAME="PSB UTL XSTATUS SRCH"
SET XWBRETNM="RESULTS"
+9 DO POST2(XWBNAME,XWBRETNM)
+10 WRITE !,"1^Successfully deleted RESULTS in PSB UTL XSTATUS SRCH"
+11 WRITE !!,"1^All three RPCs successfully updated."
+12 QUIT
+13 ;
POST2(XWBNAME,XWBRETNM) ;
+1 NEW XWBI,XWBERR,XWBFDA,XWBIEN,XWBIENS
+2 SET XWBIEN=0
SET XWBIEN=$ORDER(^XWB(8994,"B",XWBNAME,XWBIEN))
+3 SET XWBI=0
FOR
SET XWBI=$ORDER(^XWB(8994,XWBIEN,2,XWBI))
if 'XWBI
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^XWB(8994,XWBIEN,2,XWBI,0)),U)=XWBRETNM
Begin DoDot:2
+5 SET XWBIENS=XWBI_","_XWBIEN_","
+6 SET XWBFDA(8994.02,XWBIENS,.01)="@"
+7 DO FILE^DIE(,"XWBFDA","XWBERR")
IF $GET(XWBERR)'=""
WRITE !,"-1^Warning! Could not update file: "_$GET(XWBERR)
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
