ORY361 ;ISL/TC - Post-install for patch OR*3*361 ;03/24/14 12:29
;;3.0;ORDER ENTRY/RESULTS REPORTING;**361**;Dec 17, 1997;Build 39
;
; External References:
; ^DIC ICR #10006
; ^DIE ICR #10018
;
POST ; Initiate post-init processes
N ORERR
D BMES^XPDUTL("Setting default value of parameter ORQQPL SUPPRESS CODES to NO")
D EN^XPAR("PKG","ORQQPL SUPPRESS CODES",1,"NO",.ORERR)
I $D(ORERR) D BMES^XPDUTL("Error setting parameter: "_$P(ORERR,"^",2))
D UPDTRPT
Q
;
UPDTRPT ; Modify ICD Column Headers display text in PL Clinical Reports in OE/RR REPORTS file (101.24)
N I
F I=1:1:4 D
.N DIC,DA,X,J,ORIFN
.S DIC="^ORD(101.24,",DIC(0)="BIXZ"
.S X=$S(I=1:"ORRPW PROBLEM ACTIVE",I=2:"ORRPW PROBLEM ALL",I=3:"ORRPW DOD PROBLEM LIST ALL",1:"ORRPW PROBLEM INACTIVE")
.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)
.I ORIFN>1000 D ; if report is a national standard, then proceed to modify the below X fields in the subfile #101.243
..N ORDUPCOL,K,CNT,ORSUB
..D BMES^XPDUTL("Modifying the following column names of the "_X_" report:")
..F K=6:1:7 D ; check for duplicate ICD column headers and delete them
...S CNT=0,ORSUB="" F S ORSUB=$O(^ORD(101.24,ORIFN,3,"C",K,ORSUB)) Q:'ORSUB D
....S CNT=CNT+1,ORDUPCOL(CNT)=ORSUB
...I CNT>1 D
....N L F L=2:1:CNT D
.....N DIK,DA S DIK=DIC,DA(1)=ORIFN,DA=ORDUPCOL(L)
.....D ^DIK K DIK
..F J=1:1:2 D
...N X
...S X=$S(J=1:"Primary ICD-9-CM Code & Description",J=2:"Secondary ICD-9-CM Code & Description")
...D ^DIC I Y=-1 K DIC 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=".01///"_$S(J=1:"Primary ICD Code & Description",J=2:"Secondary ICD Code & Description")
...D BMES^XPDUTL(" From "_X_" to "_$P(DR,"///",2)_".")
...D ^DIE K DIE,DR,DA,Y Q ;edit the COLUMN HEADERS text of the X COLUMN HEADER multiple accordingly
..K DIC Q
.Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY361 2046 printed Dec 13, 2024@02:41:32 Page 2
ORY361 ;ISL/TC - Post-install for patch OR*3*361 ;03/24/14 12:29
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**361**;Dec 17, 1997;Build 39
+2 ;
+3 ; External References:
+4 ; ^DIC ICR #10006
+5 ; ^DIE ICR #10018
+6 ;
POST ; Initiate post-init processes
+1 NEW ORERR
+2 DO BMES^XPDUTL("Setting default value of parameter ORQQPL SUPPRESS CODES to NO")
+3 DO EN^XPAR("PKG","ORQQPL SUPPRESS CODES",1,"NO",.ORERR)
+4 IF $DATA(ORERR)
DO BMES^XPDUTL("Error setting parameter: "_$PIECE(ORERR,"^",2))
+5 DO UPDTRPT
+6 QUIT
+7 ;
UPDTRPT ; Modify ICD Column Headers display text in PL Clinical Reports in OE/RR REPORTS file (101.24)
+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)="BIXZ"
+5 SET X=$SELECT(I=1:"ORRPW PROBLEM ACTIVE",I=2:"ORRPW PROBLEM ALL",I=3:"ORRPW DOD PROBLEM LIST ALL",1:"ORRPW PROBLEM INACTIVE")
+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 ; 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
+9 NEW ORDUPCOL,K,CNT,ORSUB
+10 DO BMES^XPDUTL("Modifying the following column names of the "_X_" report:")
+11 ; check for duplicate ICD column headers and delete them
FOR K=6:1:7
Begin DoDot:3
+12 SET CNT=0
SET ORSUB=""
FOR
SET ORSUB=$ORDER(^ORD(101.24,ORIFN,3,"C",K,ORSUB))
if 'ORSUB
QUIT
Begin DoDot:4
+13 SET CNT=CNT+1
SET ORDUPCOL(CNT)=ORSUB
End DoDot:4
+14 IF CNT>1
Begin DoDot:4
+15 NEW L
FOR L=2:1:CNT
Begin DoDot:5
+16 NEW DIK,DA
SET DIK=DIC
SET DA(1)=ORIFN
SET DA=ORDUPCOL(L)
+17 DO ^DIK
KILL DIK
End DoDot:5
End DoDot:4
End DoDot:3
+18 FOR J=1:1:2
Begin DoDot:3
+19 NEW X
+20 SET X=$SELECT(J=1:"Primary ICD-9-CM Code & Description",J=2:"Secondary ICD-9-CM Code & Description")
+21 ;perform subfile entry level search for record X, if unsuccessful quit
DO ^DIC
IF Y=-1
KILL DIC
QUIT
+22 NEW DIE,DA,DR
SET DIE=DIC
SET DA=+Y
SET DA(1)=ORIFN
+23 SET DR=".01///"_$SELECT(J=1:"Primary ICD Code & Description",J=2:"Secondary ICD Code & Description")
+24 DO BMES^XPDUTL(" From "_X_" to "_$PIECE(DR,"///",2)_".")
+25 ;edit the COLUMN HEADERS text of the X COLUMN HEADER multiple accordingly
DO ^DIE
KILL DIE,DR,DA,Y
QUIT
End DoDot:3
+26 KILL DIC
QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 QUIT
+29 ;
