ORY395 ;ISP/TC,RFR - POST INSTALL FOR PATCH OR*3*395;07/23/2014 12:22
;;3.0;ORDER ENTRY/RESULTS REPORTING;**395**;Dec 17, 1997;Build 11
;
POST ; Initiate post-init processes
D UNDOPLRP,FIXMENU
Q
UNDOPLRP ; Remove SNOMED CT description, Primary ICD code/description, and Secondary ICD code/description columns from PL Clinical Reports.
N I
F I=1:1:4 D
. N DIC,DA,X,J,ORIFN
. S DIC="^ORD(101.24,",DIC(0)="BIX"
. S X=$S(I=1:"ORRPW PROBLEM ACTIVE",I=2:"ORRPW PROBLEM ALL",I=3:"ORRPW PROBLEM INACTIVE",1:"ORRPW DOD PROBLEM LIST ALL")
. D ^DIC I Y=-1 K DIC Q ; perform top file level search for record X, if unsuccessful quit
. S DA(1)=+Y,DIC=DIC_DA(1)_",3,",DIC(0)="IXZ",ORIFN=DA(1)
. D BMES^XPDUTL("Updating the "_X_" report in File #101.24.")
. L +^ORD(101.24,DA(1)):5 I '$T D Q
. . D BMES^XPDUTL("Error updating the "_X_" report in File #101.24.")
. . D BMES^XPDUTL("Another user is currently editing this report entry.")
. . Q
. I ORIFN>1000 D ; if report is a national standard, then proceed to modify the below X fields in the subfile #101.243
. . N X,L,ORPRIMCN,ORSECCLN
. . F L=1:1:2 D
. . . S X=$S(L=1:"Primary ICD-9-CM Code & Description",1:"Secondary ICD-9-CM Code & Description") D ^DIC
. . . I Y=-1 D
. . . . I L=1 S ORPRIMCN="Primary ICD Code & Description"
. . . . I L=2 S ORSECCLN="Secondary ICD Code & Description"
. . . . Q
. . . I $D(Y(0,0)),(Y(0,0)]""),(Y(0,0)["ICD-9") D
. . . . I L=1 S ORPRIMCN=Y(0,0)
. . . . I L=2 S ORSECCLN=Y(0,0)
. . F J=1:1:9 D
. . . N X,ORCOLHDR S X=$S(J=1:"Date of Onset",J=2:"Date Modified",J=3:"Provider Name ",J=4:"Note Narrative",J=5:"[+]",J=6:"Exposures",J=7:"SNOMED CT Description",J=8:ORPRIMCN,J=9:ORSECCLN)
. . . S ORCOLHDR=X
. . . D ^DIC I Y=-1 Q ;perform subfile entry level search for record X, if unsuccessful quit
. . . N DIE,DA,DR S DIE=DIC S DA=+Y,DA(1)=ORIFN
. . . S DR=".03///"_$S(J=1:"5",J=2:"6",J=3:"7",J=4:"8",J=5:"10",J=6:"9",1:"@")
. . . D ^DIE ; edit the SEQUENCE fields of the X COLUMN HEADER multiple accordingly
. . . I J>6 D
. . . . D MES^XPDUTL(" Deleting the "_ORCOLHDR_" column header.")
. . . . N DIK S DIK=DIE D ^DIK ; delete the 3 new column headers introduced in OR*3*306
. . . K DIE,DIK,DR,DA,Y Q
. . K DIC Q
. L -^ORD(101.24,DA(1)) Q
. Q
Q
N RESULT
D BMES^XPDUTL("Cleaning up menus...")
S RESULT=$$FIND("OR PARAM COORDINATOR MENU","ORE KEY CHECK")
Q:RESULT=-1
I RESULT D
.N ERROR
.D MES^XPDUTL(" Adding ORE KEY CHECK to OR PARAM COORDINATOR MENU")
.;IA #1157
.S ERROR=$$ADD^XPDMENU("OR PARAM COORDINATOR MENU","ORE KEY CHECK","KK")
.D:ERROR=1 MES^XPDUTL(" DONE")
.D:ERROR=0 MES^XPDUTL(" ORE KEY CHECK was not added to OR PARAM COORDINATOR MENU")
D MES^XPDUTL("DONE")
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
FIND(ORMENU,OROPTION) ;DETERMINE IF MENU CONTAINS OPTION
N IEN,RETURN,ERROR,ADD
;IA #10156
S ADD=1,IEN=$$FIND1^DIC(19,,"X",ORMENU)
I +$G(IEN)=0 D Q -1
.D MES^XPDUTL("ERROR: Could not find the "_ORMENU_" option in the OPTION file (#19).")
;IA #10156
D GETS^DIQ(19,IEN_",","10*",,"RETURN","ERROR")
I $D(ERROR) D ERROR(.ERROR) Q -1
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)=OROPTION ADD=0
Q ADD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY395 3535 printed Apr 09, 2024@21:38:54 Page 2
ORY395 ;ISP/TC,RFR - POST INSTALL FOR PATCH OR*3*395;07/23/2014 12:22
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**395**;Dec 17, 1997;Build 11
+2 ;
POST ; Initiate post-init processes
+1 DO UNDOPLRP
DO FIXMENU
+2 QUIT
UNDOPLRP ; Remove SNOMED CT description, Primary ICD code/description, and Secondary ICD code/description columns from PL Clinical Reports.
+1 NEW I
+2 FOR I=1:1:4
Begin DoDot:1
+3 NEW DIC,DA,X,J,ORIFN
+4 SET DIC="^ORD(101.24,"
SET DIC(0)="BIX"
+5 SET X=$SELECT(I=1:"ORRPW PROBLEM ACTIVE",I=2:"ORRPW PROBLEM ALL",I=3:"ORRPW PROBLEM INACTIVE",1:"ORRPW DOD PROBLEM LIST ALL")
+6 ; perform top file level search for record X, if unsuccessful quit
DO ^DIC
IF Y=-1
KILL DIC
QUIT
+7 SET DA(1)=+Y
SET DIC=DIC_DA(1)_",3,"
SET DIC(0)="IXZ"
SET ORIFN=DA(1)
+8 DO BMES^XPDUTL("Updating the "_X_" report in File #101.24.")
+9 LOCK +^ORD(101.24,DA(1)):5
IF '$TEST
Begin DoDot:2
+10 DO BMES^XPDUTL("Error updating the "_X_" report in File #101.24.")
+11 DO BMES^XPDUTL("Another user is currently editing this report entry.")
+12 QUIT
End DoDot:2
QUIT
+13 ; if report is a national standard, then proceed to modify the below X fields in the subfile #101.243
IF ORIFN>1000
Begin DoDot:2
+14 NEW X,L,ORPRIMCN,ORSECCLN
+15 FOR L=1:1:2
Begin DoDot:3
+16 SET X=$SELECT(L=1:"Primary ICD-9-CM Code & Description",1:"Secondary ICD-9-CM Code & Description")
DO ^DIC
+17 IF Y=-1
Begin DoDot:4
+18 IF L=1
SET ORPRIMCN="Primary ICD Code & Description"
+19 IF L=2
SET ORSECCLN="Secondary ICD Code & Description"
+20 QUIT
End DoDot:4
+21 IF $DATA(Y(0,0))
IF (Y(0,0)]"")
IF (Y(0,0)["ICD-9")
Begin DoDot:4
+22 IF L=1
SET ORPRIMCN=Y(0,0)
+23 IF L=2
SET ORSECCLN=Y(0,0)
End DoDot:4
End DoDot:3
+24 FOR J=1:1:9
Begin DoDot:3
+25 NEW X,ORCOLHDR
SET X=$SELECT(J=1:"Date of Onset",J=2:"Date Modified",J=3:"Provider Name ",J=4:"Note Narrative",J=5:"[+]",J=6:"Exposures",J=7:"SNOMED CT Description",J=8:ORPRIMCN,J=9:ORSECCLN)
+26 SET ORCOLHDR=X
+27 ;perform subfile entry level search for record X, if unsuccessful quit
DO ^DIC
IF Y=-1
QUIT
+28 NEW DIE,DA,DR
SET DIE=DIC
SET DA=+Y
SET DA(1)=ORIFN
+29 SET DR=".03///"_$SELECT(J=1:"5",J=2:"6",J=3:"7",J=4:"8",J=5:"10",J=6:"9",1:"@")
+30 ; edit the SEQUENCE fields of the X COLUMN HEADER multiple accordingly
DO ^DIE
+31 IF J>6
Begin DoDot:4
+32 DO MES^XPDUTL(" Deleting the "_ORCOLHDR_" column header.")
+33 ; delete the 3 new column headers introduced in OR*3*306
NEW DIK
SET DIK=DIE
DO ^DIK
End DoDot:4
+34 KILL DIE,DIK,DR,DA,Y
QUIT
End DoDot:3
+35 KILL DIC
QUIT
End DoDot:2
+36 LOCK -^ORD(101.24,DA(1))
QUIT
+37 QUIT
End DoDot:1
+38 QUIT
+1 NEW RESULT
+2 DO BMES^XPDUTL("Cleaning up menus...")
+3 SET RESULT=$$FIND("OR PARAM COORDINATOR MENU","ORE KEY CHECK")
+4 if RESULT=-1
QUIT
+5 IF RESULT
Begin DoDot:1
+6 NEW ERROR
+7 DO MES^XPDUTL(" Adding ORE KEY CHECK to OR PARAM COORDINATOR MENU")
+8 ;IA #1157
+9 SET ERROR=$$ADD^XPDMENU("OR PARAM COORDINATOR MENU","ORE KEY CHECK","KK")
+10 if ERROR=1
DO MES^XPDUTL(" DONE")
+11 if ERROR=0
DO MES^XPDUTL(" ORE KEY CHECK was not added to OR PARAM COORDINATOR MENU")
End DoDot:1
+12 DO MES^XPDUTL("DONE")
+13 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
FIND(ORMENU,OROPTION) ;DETERMINE IF MENU CONTAINS OPTION
+1 NEW IEN,RETURN,ERROR,ADD
+2 ;IA #10156
+3 SET ADD=1
SET IEN=$$FIND1^DIC(19,,"X",ORMENU)
+4 IF +$GET(IEN)=0
Begin DoDot:1
+5 DO MES^XPDUTL("ERROR: Could not find the "_ORMENU_" option in the OPTION file (#19).")
End DoDot:1
QUIT -1
+6 ;IA #10156
+7 DO GETS^DIQ(19,IEN_",","10*",,"RETURN","ERROR")
+8 IF $DATA(ERROR)
DO ERROR(.ERROR)
QUIT -1
+9 IF $DATA(RETURN)
Begin DoDot:1
+10 NEW IDX
+11 SET IDX=0
FOR
SET IDX=$ORDER(RETURN(19.01,IDX))
if +$GET(IDX)=0
QUIT
Begin DoDot:2
+12 if RETURN(19.01,IDX,.01)=OROPTION
SET ADD=0
End DoDot:2
End DoDot:1
+13 QUIT ADD
