ORY218 ;SLC/JLC-Update PKI user flag for DEA ;01/16/2013 06:25
;;3.0;ORDER ENTRY/RESULTS REPORTING;**218**;Dec 17, 1997;Build 87
Q
PRE ;Pre-install
;IF THE FILE ALREADY EXITS, DELETE THE DATA DICTIONARY
I $D(^DIC(100.7))>0 D
.N FILE
.D FILE^DID(100.7,,"NAME","FILE")
.D BMES^XPDUTL("Deleting existing "_$G(FILE("NAME"))_" data dictionary while preserving data...")
.N DIU
.S DIU="^ORD(100.7,",DIU(0)="T"
.D EN^DIU2
.D MES^XPDUTL("DONE")
Q
POST ;Post-install
N FDA,IENS,IEN,ERROR,Y,EXIT,SITE
D BMES^XPDUTL("Cleaning up menus...")
;IA #10156
S IEN=$$FIND1^DIC(19,,"X","ORW PARAM GUI")
I +$G(IEN)=0 D Q
.D MES^XPDUTL("ERROR: Could not find the ORW PARAM GUI option in the OPTION file (#19).")
N RETURN,ADD
S ADD=1
;IA #10156
D GETS^DIQ(19,IEN_",","10*",,"RETURN","ERROR")
I $D(ERROR) D ERROR(.ERROR) Q
I $D(RETURN) D
.N IDX
.S IDX=0 F S IDX=$O(RETURN(19.01,IDX)) Q:+$G(IDX)=0 D
..S:RETURN(19.01,IDX,.01)="OR EPCS MENU" ADD=0
I ADD=1 D
.D MES^XPDUTL(" Adding OR EPCS MENU to ORW PARAM GUI")
.S ERROR=$$ADD^XPDMENU("ORW PARAM GUI","OR EPCS MENU","DEA")
.D:ERROR=1 MES^XPDUTL("DONE")
.D:ERROR=0 MES^XPDUTL("OR EPCS MENU option was not added to the option ORW PARAM GUI")
K ERROR,IEN
I ADD=0 D MES^XPDUTL("DONE")
S EXIT="1^DONE - SITE SUCCESSFULLY CONFIGURED",SITE=$P($$SITE^VASITE(),U,2)
D BMES^XPDUTL("Configuring site "_SITE_" for ePCS...")
I $O(^ORD(100.7,0)) S EXIT="1^DONE - SITE ALREADY CONFIGURED"
I '$O(^ORD(100.7,0)) D
.S IENS="+1,",FDA(100.7,IENS,.01)=SITE,FDA(100.7,IENS,.02)="YES"
.D UPDATE^DIE("E","FDA","IEN","ERROR") K FDA
.I $D(ERROR) D ERROR(.ERROR) Q
.I $G(IEN(1))="" D Q
..D MES^XPDUTL("ERROR: FileMan did not return the new entry's internal entry number.")
..D MES^XPDUTL("Site not successfully configured.")
.S IENS="+2,"_IEN(1)_",",Y=0
.F S Y=$O(^XUSEC("ORES",Y)) Q:'Y!('+EXIT) D
..I '$$ACTIVE^XUSER(Y)!($$DEA^XUSER(,Y)="") Q
..N DATA
..D GETS^DIQ(200,Y_",","53.1;53.4","I","DATA","ERROR")
..I $D(ERROR) D ERROR(.ERROR) S EXIT="0^Site not successfully configured." Q
..I '+DATA(200,Y_",",53.1,"I") Q
..N DATE
..S DATE=+DATA(200,Y_",",53.4,"I")
..I DATE>0,(DATE<=DT) Q
..S FDA(100.71,IENS,.01)=Y D UPDATE^DIE("","FDA",,"ERROR")
..I $D(ERROR) D ERROR(.ERROR) S EXIT="0^Site not successfully configured."
..K FDA
D MES^XPDUTL($P(EXIT,U,2))
Q
ERROR(MESSAGE) ;HANDLE AN ERROR MESSAGE FROM FILEMAN
N IDX
S IDX=0 F S IDX=$O(MESSAGE("DIERR",IDX)) Q:'IDX D
.D MES^XPDUTL("FILEMAN ERROR #"_MESSAGE("DIERR",IDX)_":")
.D MES^XPDUTL(MESSAGE("DIERR",IDX,"TEXT",1))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY218 2614 printed Dec 13, 2024@02:39:16 Page 2
ORY218 ;SLC/JLC-Update PKI user flag for DEA ;01/16/2013 06:25
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**218**;Dec 17, 1997;Build 87
+2 QUIT
PRE ;Pre-install
+1 ;IF THE FILE ALREADY EXITS, DELETE THE DATA DICTIONARY
+2 IF $DATA(^DIC(100.7))>0
Begin DoDot:1
+3 NEW FILE
+4 DO FILE^DID(100.7,,"NAME","FILE")
+5 DO BMES^XPDUTL("Deleting existing "_$GET(FILE("NAME"))_" data dictionary while preserving data...")
+6 NEW DIU
+7 SET DIU="^ORD(100.7,"
SET DIU(0)="T"
+8 DO EN^DIU2
+9 DO MES^XPDUTL("DONE")
End DoDot:1
+10 QUIT
POST ;Post-install
+1 NEW FDA,IENS,IEN,ERROR,Y,EXIT,SITE
+2 DO BMES^XPDUTL("Cleaning up menus...")
+3 ;IA #10156
+4 SET IEN=$$FIND1^DIC(19,,"X","ORW PARAM GUI")
+5 IF +$GET(IEN)=0
Begin DoDot:1
+6 DO MES^XPDUTL("ERROR: Could not find the ORW PARAM GUI option in the OPTION file (#19).")
End DoDot:1
QUIT
+7 NEW RETURN,ADD
+8 SET ADD=1
+9 ;IA #10156
+10 DO GETS^DIQ(19,IEN_",","10*",,"RETURN","ERROR")
+11 IF $DATA(ERROR)
DO ERROR(.ERROR)
QUIT
+12 IF $DATA(RETURN)
Begin DoDot:1
+13 NEW IDX
+14 SET IDX=0
FOR
SET IDX=$ORDER(RETURN(19.01,IDX))
if +$GET(IDX)=0
QUIT
Begin DoDot:2
+15 if RETURN(19.01,IDX,.01)="OR EPCS MENU"
SET ADD=0
End DoDot:2
End DoDot:1
+16 IF ADD=1
Begin DoDot:1
+17 DO MES^XPDUTL(" Adding OR EPCS MENU to ORW PARAM GUI")
+18 SET ERROR=$$ADD^XPDMENU("ORW PARAM GUI","OR EPCS MENU","DEA")
+19 if ERROR=1
DO MES^XPDUTL("DONE")
+20 if ERROR=0
DO MES^XPDUTL("OR EPCS MENU option was not added to the option ORW PARAM GUI")
End DoDot:1
+21 KILL ERROR,IEN
+22 IF ADD=0
DO MES^XPDUTL("DONE")
+23 SET EXIT="1^DONE - SITE SUCCESSFULLY CONFIGURED"
SET SITE=$PIECE($$SITE^VASITE(),U,2)
+24 DO BMES^XPDUTL("Configuring site "_SITE_" for ePCS...")
+25 IF $ORDER(^ORD(100.7,0))
SET EXIT="1^DONE - SITE ALREADY CONFIGURED"
+26 IF '$ORDER(^ORD(100.7,0))
Begin DoDot:1
+27 SET IENS="+1,"
SET FDA(100.7,IENS,.01)=SITE
SET FDA(100.7,IENS,.02)="YES"
+28 DO UPDATE^DIE("E","FDA","IEN","ERROR")
KILL FDA
+29 IF $DATA(ERROR)
DO ERROR(.ERROR)
QUIT
+30 IF $GET(IEN(1))=""
Begin DoDot:2
+31 DO MES^XPDUTL("ERROR: FileMan did not return the new entry's internal entry number.")
+32 DO MES^XPDUTL("Site not successfully configured.")
End DoDot:2
QUIT
+33 SET IENS="+2,"_IEN(1)_","
SET Y=0
+34 FOR
SET Y=$ORDER(^XUSEC("ORES",Y))
if 'Y!('+EXIT)
QUIT
Begin DoDot:2
+35 IF '$$ACTIVE^XUSER(Y)!($$DEA^XUSER(,Y)="")
QUIT
+36 NEW DATA
+37 DO GETS^DIQ(200,Y_",","53.1;53.4","I","DATA","ERROR")
+38 IF $DATA(ERROR)
DO ERROR(.ERROR)
SET EXIT="0^Site not successfully configured."
QUIT
+39 IF '+DATA(200,Y_",",53.1,"I")
QUIT
+40 NEW DATE
+41 SET DATE=+DATA(200,Y_",",53.4,"I")
+42 IF DATE>0
IF (DATE<=DT)
QUIT
+43 SET FDA(100.71,IENS,.01)=Y
DO UPDATE^DIE("","FDA",,"ERROR")
+44 IF $DATA(ERROR)
DO ERROR(.ERROR)
SET EXIT="0^Site not successfully configured."
+45 KILL FDA
End DoDot:2
End DoDot:1
+46 DO MES^XPDUTL($PIECE(EXIT,U,2))
+47 QUIT
ERROR(MESSAGE) ;HANDLE AN ERROR MESSAGE FROM FILEMAN
+1 NEW IDX
+2 SET IDX=0
FOR
SET IDX=$ORDER(MESSAGE("DIERR",IDX))
if 'IDX
QUIT
Begin DoDot:1
+3 DO MES^XPDUTL("FILEMAN ERROR #"_MESSAGE("DIERR",IDX)_":")
+4 DO MES^XPDUTL(MESSAGE("DIERR",IDX,"TEXT",1))
End DoDot:1
+5 QUIT
