ORY535 ;ISL/TDP - Pre- and Post-install for patch OR*3*535 ;Sep 11, 2024@14:16:13
;;3.0;ORDER ENTRY/RESULTS REPORTING;**535**;Dec 17, 1997;Build 20
;
PRE ; Initiate pre-init processes
D RENAME("^OCXS(860.3,","GLUCOPHAGE ORDER","METFORMIN ORDER")
D CLRINDX
Q
;
CLRINDX ;Delete the "B" index of file 100.04
N DIK
D BMES^XPDUTL("Clearing 'B' indexes for file 100.04")
S DIK="^ORD(100.04,",DIK(1)=".01"
D ENALL2^DIK
D MES^XPDUTL(" Completed!")
Q
;
POST ; Initiate post-init processes
D ACTIV("GLUCOPHAGE - LAB RESULTS",1,0)
D ACTIV("METFORMIN EGFR - LAB RESULTS",0,1) ;Activate if it exists already and is inactive status
D S^ORY535ES
D BMES^XPDUTL(" ---Completed---")
D PARAMSET
D REMOVE
D REINDEX
D NATIONAL
Q
;
ACTIV(ORCHKRL,ORACTIV,PST) ; Inactivate Order Check Rule
; ORCHKRL = Name of Order Check Rule in file 860.2
; ORACTIV = Status of Order Check Rule. 0 = Active, 1 = Inactive, No value defaults to Active
; PST = Indicates METFORMIN EGFR - LAB RESULTS from Post-init code (1 = yes, 0 = no)
N ORACT,ORACT1,ORCHKRLIEN
Q:$G(ORCHKRL)=""
S ORACTIV=+$G(ORACTIV) D
. I ORACTIV=1 S ORACT="Inactivating ",ORACT1="inactivated."
. E S ORACT="Activating ",ORACT1="activated."
S ORCHKRLIEN=$O(^OCXS(860.2,"B",ORCHKRL,0))
I 'ORCHKRLIEN D Q
. I PST Q ;METFORMIN EGFR - LAB RESULTS won't exist yet on initial install
. D BMES^XPDUTL(" "_ORCHKRL_" does not exist in the ORDER CHECK")
. D MES^XPDUTL(" RULE (#860.2) file.")
. Q
I +$G(^OCXS(860.2,ORCHKRLIEN,"INACT"))=ORACTIV D Q
. D BMES^XPDUTL(" "_ORCHKRL_" is already "_ORACT1_" ABORTING action!")
. Q
D BMES^XPDUTL(ORACT_ORCHKRL_" in the ORDER CHECK")
D MES^XPDUTL("RULE (#860.2) file.")
S ^OCXS(860.2,ORCHKRLIEN,"INACT")=ORACTIV
D BMES^XPDUTL(" "_ORCHKRL_" has been "_ORACT1)
Q
;
RENAME(FILE,OROLD,ORNEW) ; Rename file entry
N CNT,DA,DIC,DIE,DO,DR,FILENM,TEXT,X,Y
Q:$G(FILE)=""
Q:$G(OROLD)=""
Q:$G(ORNEW)=""
S (DIC,DIE)=FILE
S DIC(0)="X"
S X=OROLD
D ^DIC Q:Y<1
S DA=+Y
I 'DA Q
S DIE="^OCXS(860.3,",DR=".01///"_ORNEW
D ^DIE
S FILENM=FILE
S DO=""
D DO^DIC1
I DO(2)'=-1 D
. S FILENM=$P(DO,U,1)_" (#"_$P(DO,U,2)_")"
S CNT=1
S TEXT(CNT)="Renamed "_FILENM_" file entry "_OROLD_" to "_ORNEW_"."
I $L(TEXT(CNT))>66 D
. N DONE
. S DONE=0
. S X=$L(TEXT(CNT))
. F Y=66:-1:1 D Q:DONE
.. I $E(TEXT(CNT),Y)'=" " Q
.. S TEXT(CNT+1)=$E(TEXT(CNT),Y+1,X)
.. S TEXT(CNT)=$E(TEXT(CNT),1,Y)
.. S CNT=CNT+1
.. I $L(TEXT(CNT))<66 S DONE=1
S CNT=1
D BMES^XPDUTL($G(TEXT(CNT)))
F S CNT=$O(TEXT(CNT)) Q:+CNT=0 D MES^XPDUTL(" "_$G(TEXT(CNT)))
Q
;
PARAMSET ;Set needed parameters at the Package levels
N ORPARAM,ORVAL
;ORVAL("PARAMETER NAME")="INSTANCE^VALUE"
S ORVAL("ORK METFORMIN EGFR")="1^365"
S ORVAL("ORK PROCESSING FLAG")="METFORMIN EGFR-LAB RESULTS^Enabled"
S ORVAL("ORK CLINICAL DANGER LEVEL")="METFORMIN EGFR-LAB RESULTS^High"
S ORPARAM=""
F S ORPARAM=$O(ORVAL(ORPARAM)) Q:ORPARAM="" D
. N ERR,ERRTXT,VAL
. S VAL=$P($G(ORVAL(ORPARAM)),U,2)
. D BMES^XPDUTL("Setting the Package level value to "_VAL_" for the "_ORPARAM)
. D MES^XPDUTL("parameter...")
. D EN^XPAR("PKG",ORPARAM,$P($G(ORVAL(ORPARAM)),U,1),VAL,.ERR)
. I $G(ERR)=0 D Q
.. D BMES^XPDUTL(" Completed Successfully.")
. S ERRTXT=$P($G(ERR),U,2)
. D BMES^XPDUTL("Error while setting the Package level value for the "_ORPARAM)
. D MES^XPDUTL("parameter!!!!")
. D MES^XPDUTL(" Error: "_ERRTXT)
Q
;
REMOVE ;Kill off invalid entries made due to bad "B" index setting in
;the NAME (.01) field and remove the "B" cross-reference no longer
;being used in the ORDER CHECK OVERRIDE REASONS (#100.04) file.
N OUTPUT,MSG
I $D(^OR(100.04,"B")) D
. D BMES^XPDUTL("Deleting entries stored in ^OR(100.04,""B"") index ...")
. K ^OR(100.04,"B") ;Proper location is at ^ORD(100.04,"B")
. D BMES^XPDUTL(" Completed!")
I $D(^DD(100.04,.01,1,1)) D
. D BMES^XPDUTL("Deleting Traditional ""B"" cross-reference from the Data Dictionary for the")
. D MES^XPDUTL("NAME (#.01) field in the ORDER CHECK OVERRIDE REASONS (#100.04) file ...")
. D DELIX^DDMOD(100.04,.01,1,"KW","OUTPUT","MSG")
. I $D(MSG("DIERR")) D Q
.. N ERRCODE,ERRTXT,X,Y
.. D BMES^XPDUTL("An error occurred while deleting the Traditional ""B"" cross-reference!!!")
.. S X=0
.. F S X=$O(MSG("DIERR",X)) Q:+X=0 D
... S ERRCODE=+$G(MSG("DIERR",X))
... I ERRCODE>0 D MES^XPDUTL("ERROR CODE: "_ERRCODE)
... S Y=0
... F S Y=$O(MSG("DIERR",X,"TEXT",Y)) Q:+Y=0 D
.... D MES^XPDUTL($G(MSG("DIERR",X,"TEXT",1)))
. D BMES^XPDUTL(" Completed!")
Q
;
NATIONAL ;Set the NATIONAL (#.05) field for the nationally released
;ORDER CHECK OVERRIDE REASONS (#100.04) entries to YES.
;Reset entries if they have been modified or removed.
N ORLINE,ORACT,ORDATA,ORNAME,ORNAT,ORSYN,ORTYPE,ORVAL
D BMES^XPDUTL("Updating file #100.04 National entries.")
F ORLINE=1:1:10 D
. N DA,DIC,DIE,DINUM,DO,DR,DTOUT,DUOUT,Y,X
. S ORVAL=$P($T(REASONS+ORLINE^ORY535),";",3)
. S ORNAME=$P(ORVAL,U,1)
. S ORSYN=$P(ORVAL,U,2)
. S ORTYPE=$P(ORVAL,U,3)
. S ORACT=$P(ORVAL,U,4)
. S ORNAT=$P(ORVAL,U,5)
. S DA=$O(^ORD(100.04,"B",ORNAME,""))
. I 'DA D Q
.. D MES^XPDUTL(" '"_ORNAME_"' does not exist!!!")
.. D MES^XPDUTL(" Adding ...")
.. S X=ORNAME
.. S DIC="^ORD(100.04,",DIC(0)=""
.. S DIC("DR")=".02///^S X=ORSYN;.03///^S X=ORTYPE;.04///^S X=ORACT;.05///^S X=ORNAT"
.. D FILE^DICN
.. I Y<0 D MES^XPDUTL(" ERROR occurred. Entry not added!!!")
. D MES^XPDUTL(" Updating '"_ORNAME_"'")
. S ORDATA=$G(^ORD(100.04,+DA,0))
. S DIE="^ORD(100.04,"
. S DR=""
. I $P(ORDATA,U,2)'=ORSYN S DR=".02///^S X=ORSYN"_";"
. I $P(ORDATA,U,3)'=ORTYPE S DR=DR_".03///^S X=ORTYPE"_";"
. I $P(ORDATA,U,4)'=ORACT S DR=DR_".04///^S X=ORACT"_";"
. S DR=DR_".05///^S X=ORNAT"
. D ^DIE
D BMES^XPDUTL("Completed update of 100.04 National file entries!")
Q
;
REINDEX ;Reindex "B" cross reference in file 100.04
N DIK
D BMES^XPDUTL("Reindexing the 'B' cross reference for file 100.04")
S DIK="^ORD(100.04,",DIK(1)=".01"
D ENALL^DIK
D MES^XPDUTL(" Completed!")
Q
;
REASONS ;File 100.04 file entries
;1;Benefit of Therapy Outweighs Risk^BEN^B^1^1
;2;Patient tolerating current therapy with this medication^PAT^B^1^1
;3;Previous Adverse Reaction signs/symptoms managed by patient^PRE^B^1^1
;4;Renewal of Current Therapy^REN^B^1^1
;5;Will Monitor Closely for Adverse Effects^WILL^B^1^1
;6;Documentation of Allergy/Adverse Reaction is in Error^DOCAA^B^1^1
;7;Documentation of Allergy/Adverse Reaction is to different agent in same drug class^DOAD^B^1^1
;8;Patient report per interview is inconsistent with remote allergy data.^REM^B^1^1
;9;Indicated for procedure. Risks mitigated and will monitor.^IND^B^1^1
;10;Patient counselled risks/benefits, verbalizes understanding, and elects to proceed^COUNSELLED^B^1^1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY535 6973 printed Dec 13, 2024@02:42:30 Page 2
ORY535 ;ISL/TDP - Pre- and Post-install for patch OR*3*535 ;Sep 11, 2024@14:16:13
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**535**;Dec 17, 1997;Build 20
+2 ;
PRE ; Initiate pre-init processes
+1 DO RENAME("^OCXS(860.3,","GLUCOPHAGE ORDER","METFORMIN ORDER")
+2 DO CLRINDX
+3 QUIT
+4 ;
CLRINDX ;Delete the "B" index of file 100.04
+1 NEW DIK
+2 DO BMES^XPDUTL("Clearing 'B' indexes for file 100.04")
+3 SET DIK="^ORD(100.04,"
SET DIK(1)=".01"
+4 DO ENALL2^DIK
+5 DO MES^XPDUTL(" Completed!")
+6 QUIT
+7 ;
POST ; Initiate post-init processes
+1 DO ACTIV("GLUCOPHAGE - LAB RESULTS",1,0)
+2 ;Activate if it exists already and is inactive status
DO ACTIV("METFORMIN EGFR - LAB RESULTS",0,1)
+3 DO S^ORY535ES
+4 DO BMES^XPDUTL(" ---Completed---")
+5 DO PARAMSET
+6 DO REMOVE
+7 DO REINDEX
+8 DO NATIONAL
+9 QUIT
+10 ;
ACTIV(ORCHKRL,ORACTIV,PST) ; Inactivate Order Check Rule
+1 ; ORCHKRL = Name of Order Check Rule in file 860.2
+2 ; ORACTIV = Status of Order Check Rule. 0 = Active, 1 = Inactive, No value defaults to Active
+3 ; PST = Indicates METFORMIN EGFR - LAB RESULTS from Post-init code (1 = yes, 0 = no)
+4 NEW ORACT,ORACT1,ORCHKRLIEN
+5 if $GET(ORCHKRL)=""
QUIT
+6 SET ORACTIV=+$GET(ORACTIV)
Begin DoDot:1
+7 IF ORACTIV=1
SET ORACT="Inactivating "
SET ORACT1="inactivated."
+8 IF '$TEST
SET ORACT="Activating "
SET ORACT1="activated."
End DoDot:1
+9 SET ORCHKRLIEN=$ORDER(^OCXS(860.2,"B",ORCHKRL,0))
+10 IF 'ORCHKRLIEN
Begin DoDot:1
+11 ;METFORMIN EGFR - LAB RESULTS won't exist yet on initial install
IF PST
QUIT
+12 DO BMES^XPDUTL(" "_ORCHKRL_" does not exist in the ORDER CHECK")
+13 DO MES^XPDUTL(" RULE (#860.2) file.")
+14 QUIT
End DoDot:1
QUIT
+15 IF +$GET(^OCXS(860.2,ORCHKRLIEN,"INACT"))=ORACTIV
Begin DoDot:1
+16 DO BMES^XPDUTL(" "_ORCHKRL_" is already "_ORACT1_" ABORTING action!")
+17 QUIT
End DoDot:1
QUIT
+18 DO BMES^XPDUTL(ORACT_ORCHKRL_" in the ORDER CHECK")
+19 DO MES^XPDUTL("RULE (#860.2) file.")
+20 SET ^OCXS(860.2,ORCHKRLIEN,"INACT")=ORACTIV
+21 DO BMES^XPDUTL(" "_ORCHKRL_" has been "_ORACT1)
+22 QUIT
+23 ;
RENAME(FILE,OROLD,ORNEW) ; Rename file entry
+1 NEW CNT,DA,DIC,DIE,DO,DR,FILENM,TEXT,X,Y
+2 if $GET(FILE)=""
QUIT
+3 if $GET(OROLD)=""
QUIT
+4 if $GET(ORNEW)=""
QUIT
+5 SET (DIC,DIE)=FILE
+6 SET DIC(0)="X"
+7 SET X=OROLD
+8 DO ^DIC
if Y<1
QUIT
+9 SET DA=+Y
+10 IF 'DA
QUIT
+11 SET DIE="^OCXS(860.3,"
SET DR=".01///"_ORNEW
+12 DO ^DIE
+13 SET FILENM=FILE
+14 SET DO=""
+15 DO DO^DIC1
+16 IF DO(2)'=-1
Begin DoDot:1
+17 SET FILENM=$PIECE(DO,U,1)_" (#"_$PIECE(DO,U,2)_")"
End DoDot:1
+18 SET CNT=1
+19 SET TEXT(CNT)="Renamed "_FILENM_" file entry "_OROLD_" to "_ORNEW_"."
+20 IF $LENGTH(TEXT(CNT))>66
Begin DoDot:1
+21 NEW DONE
+22 SET DONE=0
+23 SET X=$LENGTH(TEXT(CNT))
+24 FOR Y=66:-1:1
Begin DoDot:2
+25 IF $EXTRACT(TEXT(CNT),Y)'=" "
QUIT
+26 SET TEXT(CNT+1)=$EXTRACT(TEXT(CNT),Y+1,X)
+27 SET TEXT(CNT)=$EXTRACT(TEXT(CNT),1,Y)
+28 SET CNT=CNT+1
+29 IF $LENGTH(TEXT(CNT))<66
SET DONE=1
End DoDot:2
if DONE
QUIT
End DoDot:1
+30 SET CNT=1
+31 DO BMES^XPDUTL($GET(TEXT(CNT)))
+32 FOR
SET CNT=$ORDER(TEXT(CNT))
if +CNT=0
QUIT
DO MES^XPDUTL(" "_$GET(TEXT(CNT)))
+33 QUIT
+34 ;
PARAMSET ;Set needed parameters at the Package levels
+1 NEW ORPARAM,ORVAL
+2 ;ORVAL("PARAMETER NAME")="INSTANCE^VALUE"
+3 SET ORVAL("ORK METFORMIN EGFR")="1^365"
+4 SET ORVAL("ORK PROCESSING FLAG")="METFORMIN EGFR-LAB RESULTS^Enabled"
+5 SET ORVAL("ORK CLINICAL DANGER LEVEL")="METFORMIN EGFR-LAB RESULTS^High"
+6 SET ORPARAM=""
+7 FOR
SET ORPARAM=$ORDER(ORVAL(ORPARAM))
if ORPARAM=""
QUIT
Begin DoDot:1
+8 NEW ERR,ERRTXT,VAL
+9 SET VAL=$PIECE($GET(ORVAL(ORPARAM)),U,2)
+10 DO BMES^XPDUTL("Setting the Package level value to "_VAL_" for the "_ORPARAM)
+11 DO MES^XPDUTL("parameter...")
+12 DO EN^XPAR("PKG",ORPARAM,$PIECE($GET(ORVAL(ORPARAM)),U,1),VAL,.ERR)
+13 IF $GET(ERR)=0
Begin DoDot:2
+14 DO BMES^XPDUTL(" Completed Successfully.")
End DoDot:2
QUIT
+15 SET ERRTXT=$PIECE($GET(ERR),U,2)
+16 DO BMES^XPDUTL("Error while setting the Package level value for the "_ORPARAM)
+17 DO MES^XPDUTL("parameter!!!!")
+18 DO MES^XPDUTL(" Error: "_ERRTXT)
End DoDot:1
+19 QUIT
+20 ;
REMOVE ;Kill off invalid entries made due to bad "B" index setting in
+1 ;the NAME (.01) field and remove the "B" cross-reference no longer
+2 ;being used in the ORDER CHECK OVERRIDE REASONS (#100.04) file.
+3 NEW OUTPUT,MSG
+4 IF $DATA(^OR(100.04,"B"))
Begin DoDot:1
+5 DO BMES^XPDUTL("Deleting entries stored in ^OR(100.04,""B"") index ...")
+6 ;Proper location is at ^ORD(100.04,"B")
KILL ^OR(100.04,"B")
+7 DO BMES^XPDUTL(" Completed!")
End DoDot:1
+8 IF $DATA(^DD(100.04,.01,1,1))
Begin DoDot:1
+9 DO BMES^XPDUTL("Deleting Traditional ""B"" cross-reference from the Data Dictionary for the")
+10 DO MES^XPDUTL("NAME (#.01) field in the ORDER CHECK OVERRIDE REASONS (#100.04) file ...")
+11 DO DELIX^DDMOD(100.04,.01,1,"KW","OUTPUT","MSG")
+12 IF $DATA(MSG("DIERR"))
Begin DoDot:2
+13 NEW ERRCODE,ERRTXT,X,Y
+14 DO BMES^XPDUTL("An error occurred while deleting the Traditional ""B"" cross-reference!!!")
+15 SET X=0
+16 FOR
SET X=$ORDER(MSG("DIERR",X))
if +X=0
QUIT
Begin DoDot:3
+17 SET ERRCODE=+$GET(MSG("DIERR",X))
+18 IF ERRCODE>0
DO MES^XPDUTL("ERROR CODE: "_ERRCODE)
+19 SET Y=0
+20 FOR
SET Y=$ORDER(MSG("DIERR",X,"TEXT",Y))
if +Y=0
QUIT
Begin DoDot:4
+21 DO MES^XPDUTL($GET(MSG("DIERR",X,"TEXT",1)))
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+22 DO BMES^XPDUTL(" Completed!")
End DoDot:1
+23 QUIT
+24 ;
NATIONAL ;Set the NATIONAL (#.05) field for the nationally released
+1 ;ORDER CHECK OVERRIDE REASONS (#100.04) entries to YES.
+2 ;Reset entries if they have been modified or removed.
+3 NEW ORLINE,ORACT,ORDATA,ORNAME,ORNAT,ORSYN,ORTYPE,ORVAL
+4 DO BMES^XPDUTL("Updating file #100.04 National entries.")
+5 FOR ORLINE=1:1:10
Begin DoDot:1
+6 NEW DA,DIC,DIE,DINUM,DO,DR,DTOUT,DUOUT,Y,X
+7 SET ORVAL=$PIECE($TEXT(REASONS+ORLINE^ORY535),";",3)
+8 SET ORNAME=$PIECE(ORVAL,U,1)
+9 SET ORSYN=$PIECE(ORVAL,U,2)
+10 SET ORTYPE=$PIECE(ORVAL,U,3)
+11 SET ORACT=$PIECE(ORVAL,U,4)
+12 SET ORNAT=$PIECE(ORVAL,U,5)
+13 SET DA=$ORDER(^ORD(100.04,"B",ORNAME,""))
+14 IF 'DA
Begin DoDot:2
+15 DO MES^XPDUTL(" '"_ORNAME_"' does not exist!!!")
+16 DO MES^XPDUTL(" Adding ...")
+17 SET X=ORNAME
+18 SET DIC="^ORD(100.04,"
SET DIC(0)=""
+19 SET DIC("DR")=".02///^S X=ORSYN;.03///^S X=ORTYPE;.04///^S X=ORACT;.05///^S X=ORNAT"
+20 DO FILE^DICN
+21 IF Y<0
DO MES^XPDUTL(" ERROR occurred. Entry not added!!!")
End DoDot:2
QUIT
+22 DO MES^XPDUTL(" Updating '"_ORNAME_"'")
+23 SET ORDATA=$GET(^ORD(100.04,+DA,0))
+24 SET DIE="^ORD(100.04,"
+25 SET DR=""
+26 IF $PIECE(ORDATA,U,2)'=ORSYN
SET DR=".02///^S X=ORSYN"_";"
+27 IF $PIECE(ORDATA,U,3)'=ORTYPE
SET DR=DR_".03///^S X=ORTYPE"_";"
+28 IF $PIECE(ORDATA,U,4)'=ORACT
SET DR=DR_".04///^S X=ORACT"_";"
+29 SET DR=DR_".05///^S X=ORNAT"
+30 DO ^DIE
End DoDot:1
+31 DO BMES^XPDUTL("Completed update of 100.04 National file entries!")
+32 QUIT
+33 ;
REINDEX ;Reindex "B" cross reference in file 100.04
+1 NEW DIK
+2 DO BMES^XPDUTL("Reindexing the 'B' cross reference for file 100.04")
+3 SET DIK="^ORD(100.04,"
SET DIK(1)=".01"
+4 DO ENALL^DIK
+5 DO MES^XPDUTL(" Completed!")
+6 QUIT
+7 ;
REASONS ;File 100.04 file entries
+1 ;1;Benefit of Therapy Outweighs Risk^BEN^B^1^1
+2 ;2;Patient tolerating current therapy with this medication^PAT^B^1^1
+3 ;3;Previous Adverse Reaction signs/symptoms managed by patient^PRE^B^1^1
+4 ;4;Renewal of Current Therapy^REN^B^1^1
+5 ;5;Will Monitor Closely for Adverse Effects^WILL^B^1^1
+6 ;6;Documentation of Allergy/Adverse Reaction is in Error^DOCAA^B^1^1
+7 ;7;Documentation of Allergy/Adverse Reaction is to different agent in same drug class^DOAD^B^1^1
+8 ;8;Patient report per interview is inconsistent with remote allergy data.^REM^B^1^1
+9 ;9;Indicated for procedure. Risks mitigated and will monitor.^IND^B^1^1
+10 ;10;Patient counselled risks/benefits, verbalizes understanding, and elects to proceed^COUNSELLED^B^1^1
+11 QUIT
