Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORY306

ORY306.m

Go to the documentation of this file.
  1. ORY306 ;ISL/TC,JER - Pre- and Post-install for patch OR*3*306 ;02/15/13 09:34
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**306**;Dec 17, 1997;Build 43
  1. ;
  1. PRE ; Initiate pre-init processes
  1. D UPDTRPT
  1. S DIK="^DD(101.52,",DA(1)=101.52,DA=23
  1. D ^DIK
  1. Q
  1. ;
  1. POST ; Initiate post-init processes
  1. D SETMGS
  1. D REGRPCS
  1. ; *** NOTE: Remove DEA Subroutine and Call prior to deployment of I1 ***
  1. D DEA
  1. D DLGBULL
  1. D CONSQO
  1. D SENDMAIL
  1. D DELPARAM
  1. D DELRPC
  1. D PARAM
  1. D NOTPARAM
  1. D QPR^ORY306PR
  1. D ^ORY306ES
  1. Q
  1. ;
  1. UPDTRPT ; Modify PL Clinical Reports in OE/RR REPORTS file (101.24) to support PL Data Standardization
  1. N I
  1. F I=1:1:4 D
  1. .N DIC,DA,X,J,ORIFN
  1. .S DIC="^ORD(101.24,",DIC(0)="BIXZ"
  1. .S X=$S(I=1:"ORRPW PROBLEM ACTIVE",I=2:"ORRPW PROBLEM ALL",I=3:"ORRPW DOD PROBLEM LIST ALL",1:"ORRPW PROBLEM INACTIVE")
  1. .D ^DIC I Y=-1 K DIC Q ; perform top file level search for record X, if unsuccessful quit
  1. .S DA(1)=+Y,DIC=DIC_DA(1)_",3,",DIC(0)="LIXZ",ORIFN=DA(1)
  1. .I ORIFN>1000 D ; if report is a national standard, then proceed to modify the below X fields in the subfile #101.243
  1. ..F J=1:1:9 D
  1. ...N X
  1. ...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:"Primary ICD-9-CM Code & Description",J=9:"Secondary ICD-9-CM Code & Description")
  1. ...I J>6 S DIC("DR")=".02///;.03///;.05///;.06///;.07///;.09///"
  1. ...D ^DIC I Y=-1 K DIC Q ;perform subfile entry level search for record X, if unsuccessful quit
  1. ...N DIE,DA,DR,DR1 S DIE=DIC S DA=+Y,DA(1)=ORIFN
  1. ...I J>6 S DR1=";.02///NO;.05///YES;.06///"_$S(J=7:"18",J=8:"10",J=9:"20")_";.07///NO;.09///FREE TEXT"_$S(J=9:";.04///WORD PROCESSING",1:"")
  1. ...S DR=".03///"_$S(J=1:"8",J=2:"9",J=3:"10",J=4:"11",J=5:"13",J=6:"12",J=7:"5",J=8:"6",J=9:"7")_$S(J>6:DR1,1:"")
  1. ...D ^DIE K DIE,DR,DA,Y Q ;edit the SEQUENCE and above DR1 fields of the X COLUMN HEADER multiple accordingly
  1. ..K DIC Q
  1. .Q
  1. Q
  1. ;
  1. UNDO ;
  1. N I
  1. F I=1:1:3 D
  1. . N DIC,DA,X,J,ORIFN
  1. . S DIC="^ORD(101.24,",DIC(0)="BIXZ"
  1. . S X=$S(I=1:"ORRPW PROBLEM ACTIVE",I=2:"ORRPW PROBLEM ALL",1:"ORRPW PROBLEM INACTIVE")
  1. . D ^DIC I Y=-1 K DIC Q ; perform top file level search for record X, if unsuccessful quit
  1. . S DA(1)=+Y,DIC=DIC_DA(1)_",3,",DIC(0)="IXZ",ORIFN=DA(1)
  1. . I ORIFN>1000 D ; if report is a national standard, then proceed to modify the below X fields in the subfile #101.243
  1. . . F J=1:1:9 D
  1. . . . N X 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")
  1. . . . ;I J>6 S DIC("DR")=".02///;.03///;.05///;.06///;.07///;.09///"
  1. . . . D ^DIC I Y=-1 K DIC Q ;perform subfile entry level search for record X, if unsuccessful quit
  1. . . . N DIE,DA,DR,DR1 S DIE=DIC S DA=+Y,DA(1)=ORIFN
  1. . . . ;I J>6 S DR1=".01///@;.02///@;.05///@;.06///@;.07///@;.09///@"_$S(J=9:";.04///@",1:"")
  1. . . . 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 K DIE,DR,DA,Y Q ;edit the SEQUENCE and above DR1 fields of the X COLUMN HEADER multiple accordingly
  1. . . K DIC Q
  1. . Q
  1. Q
  1. ;
  1. SETMGS ; set mail group for OR PROBLEM NTRT BULLETIN
  1. N ORBIEN,ORBNM,ORERRF,ORFDA,ORGIEN,ORGNM,ORLNE
  1. N ORMSG,ORTXT
  1. K ORMSG
  1. D BMES^XPDUTL("Attaching Mail Groups to OR PROBLEM NTRT BULLETIN")
  1. S ORBNM="OR PROBLEM NTRT BULLETIN"
  1. S ORBIEN=$$FIND1^DIC(3.6,"","X",ORBNM,"","","")
  1. ;If Bulletin not found, error
  1. I ORBIEN'>0 D I 1
  1. . S ORMSG(1)="**"
  1. . S ORMSG(2)="** Bulletin "_ORBNM_" not found"
  1. . D MES^XPDUTL(.ORMSG) K ORMSG
  1. . S ORERRF=1
  1. ELSE D
  1. . S ORGNM="OR CACS"
  1. . S ORGIEN=$$FIND1^DIC(3.8,"","X",ORGNM,"","","")
  1. . ;If Mail Group not found, error
  1. . I ORGIEN'>0 D Q
  1. . . S ORMSG(1)="**"
  1. . . S ORMSG(2)="** Mail Group "_ORGNM_" not found"
  1. . . D MES^XPDUTL(.ORMSG) K ORMSG
  1. . . S ORERRF=1
  1. . ;Attach Mail Group to Bulletin
  1. . N ORFDA,ORIEN,ORMSG
  1. . S ORFDA(3.62,"?+2,"_ORBIEN_",",.01)=ORGIEN
  1. . D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
  1. . ;Check for error
  1. . I $D(ORMSG("DIERR")) D Q
  1. . . S ORMSG(1)="**"
  1. . . S ORMSG(2)="** Unable to attach "_ORGNM_" to "_ORBNM
  1. . . D MES^XPDUTL(.ORMSG) K ORMSG
  1. . . S ORERRF=1
  1. . S ORMSG(1)=" "
  1. . S ORMSG(2)="... G."_ORGNM_$S($G(ORIEN(2,0))="?":" already",1:"")_" attached to "_ORBNM_" Bulletin"
  1. . D MES^XPDUTL(.ORMSG) K ORMSG
  1. ;Check for error
  1. I $G(ORERRF) D
  1. . S ORMSG(1)="** Post-installation interrupted"
  1. . S ORMSG(2)="** Please contact Enterprise VistA Support"
  1. . D MES^XPDUTL(.ORMSG) K ORMSG
  1. Q
  1. ;
  1. INSERT(OPTION,RPC) ; Call FM Updater with each RPC
  1. ; Input -- OPTION Option file (#19) Name field (#.01)
  1. ; RPC RPC sub-file (#19.05) RPC field (#.01)
  1. ; Output -- None
  1. N FDA,FDAIEN,ERR,DIERR
  1. S FDA(19,"?1,",.01)=OPTION
  1. S FDA(19.05,"?+2,?1,",.01)=RPC
  1. D UPDATE^DIE("E","FDA","FDAIEN","ERR")
  1. Q
  1. ;
  1. REGRPCS ; Register new RPCs
  1. D INSERT("OR CPRS GUI CHART","ORQQPL PROBLEM NTRT BULLETIN")
  1. D INSERT("OR CPRS GUI CHART","ORWPCE GET DX TEXT")
  1. Q
  1. ;
  1. SENDDLG(ANAME) ; Return true if the current order dialog should be sent
  1. I ANAME="GMRCOR CONSULT" Q 1
  1. I ANAME="GMRCOR REQUEST" Q 1
  1. Q 0
  1. ;
  1. DLGBULL ; send bulletin about modified dialogs <on first install>
  1. N I,ORD
  1. F I="GMRCOR CONSULT","GMRCOR REQUEST" S ORD(I)=""
  1. D EN^ORYDLG(306,.ORD)
  1. Q
  1. PARAM ;set param value/WAT
  1. N ORERR
  1. D BMES^XPDUTL("Setting paramteter ORCDGMRC EARLIEST DATE DEFAULT to TODAY")
  1. D EN^XPAR("PKG","ORCDGMRC EARLIEST DATE DEFAULT",1,"TODAY",.ORERR)
  1. I $D(ORERR) D BMES^XPDUTL("Error setting parameter: "_$P(ORERR,"^",2))
  1. Q
  1. ;
  1. CONSQO ;get GMRC QOs with date default/WAT
  1. D BMES^XPDUTL("Finding all consult/procedure quick orders with a default value in the EARLIEST")
  1. D MES^XPDUTL("APPROPRIATE DATE field")
  1. D BMES^XPDUTL("A MailMan containing the list of quick orders will be sent to the installer")
  1. D WAIT^DICD
  1. D GMRCQO
  1. Q
  1. GMRCQO ;find GMRC QO's to show the EAD default value/WAT
  1. K ^TMP("OREAD",$J)
  1. N GMRCPKG,DA,DA1,QONAME,RESPONSE,OREAD,COUNT
  1. S GMRCPKG=$O(^DIC(9.4,"B","CONSULT/REQUEST TRACKING",""))
  1. I +$G(GMRCPKG)'>0 D MES^XPDUTL(" CONSULT/REQUEST TRACKING NOT FOUND IN PACKAGE FILE ") Q
  1. S OREAD=$O(^ORD(101.41,"B","OR GTX EARLIEST DATE",""))
  1. I +$G(OREAD)'>0 D MES^XPDUTL(" OR GTX EARLIEST DATE NOT FOUND IN ORDERABLE ITEMS FILE ") Q
  1. S (QONAME,DA,DA1)="",COUNT=1
  1. S ^TMP("OREAD",$J,COUNT)="Contains Consult and Procedure quick orders with a default value stored",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="in the Earliest Appropriate Date field.",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="These quick orders should be reviewed in light of the new parameter",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="released in OR*3*306, ORCDGMRC EARLIEST DATE DEFAULT.",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="This parameter sets the default value for the Earliest Appropriate Date.",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="Data format of the entries in this message are as follows:",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="IEN from file 101.41^Quick Order Name^Earliest Appropriate Date value",COUNT=COUNT+1
  1. S ^TMP("OREAD",$J,COUNT)="",COUNT=COUNT+1
  1. F S QONAME=$O(^ORD(101.41,"B",QONAME)) Q:QONAME="" D
  1. .F S DA=$O(^ORD(101.41,"B",QONAME,DA)) Q:DA="" D
  1. ..Q:$P(^ORD(101.41,DA,0),U,4)'="Q"
  1. ..Q:$P(^ORD(101.41,DA,0),U,7)'=+GMRCPKG
  1. ..;now find the EAD in the items for this QO and show that value
  1. ..F S DA1=$O(^ORD(101.41,DA,6,DA1)) Q:DA1="" D
  1. ...Q:DA1<1
  1. ...S RESPONSE=$P(^ORD(101.41,DA,6,DA1,0),U,2)
  1. ...Q:RESPONSE'=+OREAD
  1. ...S ^TMP("OREAD",$J,COUNT)=DA_"^"_QONAME_"^"_^ORD(101.41,DA,6,DA1,1),COUNT=COUNT+1
  1. I COUNT'>9 S ^TMP("OREAD",$J,COUNT)="No Consult or Procedure quick orders found with a default value stored."
  1. Q
  1. ;
  1. SENDMAIL ;SEND MESSAGE W/QOs AND DEFAULT VALUES/WAT
  1. N XMSUB,XMTEXT,XMY,XMZ,XMDUZ,XMMG,DIFROM
  1. S XMSUB="CONSULT/PROCEDURE QOs EARLIEST APPROPRIATE DATE DEFAULT VALUE"
  1. S:$G(DUZ) XMY(DUZ)=""
  1. S XMDUZ="OR*3.0*306 POST INSTALL"
  1. S XMTEXT="^TMP(""OREAD"",$J,"
  1. D ^XMD
  1. D BMES^XPDUTL("Message #"_$G(XMZ)_" has been sent")
  1. K ^TMP("OREAD",$J)
  1. Q
  1. ;
  1. DELPARAM ;remove parameter values, then parameter/WAT
  1. ;;icr 2263 ^XPAR, 10141 XPDUTL
  1. N ORLIST,ENT,PAR,OERR
  1. ;get instances of parameter
  1. S ENT="",PAR="OR USE MH DLL"
  1. D ENVAL^XPAR(.ORLIST,PAR,1,.OERR)
  1. ;delete instances
  1. D BMES^XPDUTL("Attempting to remove values for parameter OR USE MH DLL...")
  1. F S ENT=$O(ORLIST(ENT)) Q:ENT="" D DEL^XPAR(ENT,PAR,1,.OERR) I $G(OERR)>0 W !,OERR
  1. D:+$G(OERR)=0 MES^XPDUTL("Delete successful")
  1. ;delete parameter
  1. N DA,DIK
  1. S DIK="^XTV(8989.51,"
  1. S DA=$O(^XTV(8989.51,"B",PAR,"")) Q:+$G(DA)'>0 D BMES^XPDUTL("Attempting to remove parameter OR USE MH DLL from PARAMETER DEFINITION file")
  1. D ^DIK D:+$G(DA)>0 MES^XPDUTL("Delete successful")
  1. Q
  1. ;
  1. DELRPC ;remove ORQQPXRM MHDLLDMS/WAT
  1. ;;icr 10013 ^DIK, 10141 xpdutl
  1. N DIK,DA
  1. S DIK="^XWB(8994,"
  1. S DA=$O(^XWB(8994,"B","ORQQPXRM MHDLLDMS","")) I +$G(DA)'>0 D BMES^XPDUTL("RPC OQQPXRM MHDLLDMS not found. Nothing deleted.") Q
  1. D BMES^XPDUTL("Attempting to remove ORQQPXRM MHDLLDMS from REMOTE PROCEDURE file")
  1. D ^DIK
  1. D:+$G(DA)>0 MES^XPDUTL("Delete successful")
  1. Q
  1. ;
  1. ; *** NOTE: Remove DEA Subroutine and Call prior to deployment of I1 ***
  1. ;
  1. DEA ;
  1. N ORMSG,ORERR
  1. S ORMSG(1)="By completing the two-factor authentication protocol at this time, you are legally signing the prescription(s) and authorizing the transmission of the above information to the pharmacy for dispersing. "
  1. S ORMSG(2)="The two-factor authentication protocol may only be completed by the practitioner whose name and DEA registration number appear above."
  1. D EN^XPAR("SYS","OR DEA TEXT",,.ORMSG,.ORERR)
  1. Q
  1. NOTPARAM ; parameter transport routine
  1. K ^TMP($J,"XPARRSTR")
  1. N ENT,IDX,ROOT,REF,VAL,I
  1. S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_"," ;ICR #2336
  1. D LOAD
  1. XX2 S IDX=0,ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING"
  1. F S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX D
  1. . N PAR,INST,ORVAL,ORERR K ORVAL
  1. . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
  1. . M ORVAL=^TMP($J,"XPARRSTR",IDX,"VAL")
  1. . D EN^XPAR(ENT,PAR,INST,.ORVAL,.ORERR) ;ICR #2336
  1. K ^TMP($J,"XPARRSTR")
  1. Q
  1. LOAD ; load data into ^TMP (expects ROOT to be defined)
  1. S I=1 F S REF=$T(DATA+I) Q:REF="" S VAL=$T(DATA+I+1) D
  1. . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
  1. . S @(ROOT_REF)=VAL
  1. Q
  1. DATA ; parameter data
  1. ;;7000,"KEY")
  1. ;;ORB ARCHIVE PERIOD^DEA AUTO DC CS MED ORDER
  1. ;;7000,"VAL")
  1. ;;30
  1. ;;7001,"KEY")
  1. ;;ORB DELETE MECHANISM^DEA AUTO DC CS MED ORDER
  1. ;;7001,"VAL")
  1. ;;Individual Recipient
  1. ;;7002,"KEY")
  1. ;;ORB FORWARD BACKUP REVIEWER^DEA AUTO DC CS MED ORDER
  1. ;;7002,"VAL")
  1. ;;0
  1. ;;7003,"KEY")
  1. ;;ORB FORWARD SUPERVISOR^DEA AUTO DC CS MED ORDER
  1. ;;7003,"VAL")
  1. ;;0
  1. ;;7004,"KEY")
  1. ;;ORB FORWARD SURROGATES^DEA AUTO DC CS MED ORDER
  1. ;;7004,"VAL")
  1. ;;0
  1. ;;7005,"KEY")
  1. ;;ORB PROCESSING FLAG^DEA AUTO DC CS MED ORDER
  1. ;;7005,"VAL")
  1. ;;Disabled
  1. ;;7006,"KEY")
  1. ;;ORB PROVIDER RECIPIENTS^DEA AUTO DC CS MED ORDER
  1. ;;7006,"VAL")
  1. ;;OT
  1. ;;7007,"KEY")
  1. ;;ORB URGENCY^DEA AUTO DC CS MED ORDER
  1. ;;7007,"VAL")
  1. ;;High
  1. ;;7008,"KEY")
  1. ;;ORB ARCHIVE PERIOD^DEA CERTIFICATE REVOKED
  1. ;;7008,"VAL")
  1. ;;30
  1. ;;7009,"KEY")
  1. ;;ORB DELETE MECHANISM^DEA CERTIFICATE REVOKED
  1. ;;7009,"VAL")
  1. ;;Individual Recipient
  1. ;;7010,"KEY")
  1. ;;ORB FORWARD BACKUP REVIEWER^DEA CERTIFICATE REVOKED
  1. ;;7010,"VAL")
  1. ;;0
  1. ;;7011,"KEY")
  1. ;;ORB FORWARD SUPERVISOR^DEA CERTIFICATE REVOKED
  1. ;;7011,"VAL")
  1. ;;0
  1. ;;7012,"KEY")
  1. ;;ORB FORWARD SURROGATES^DEA CERTIFICATE REVOKED
  1. ;;7012,"VAL")
  1. ;;0
  1. ;;7013,"KEY")
  1. ;;ORB PROCESSING FLAG^DEA CERTIFICATE REVOKED
  1. ;;7013,"VAL")
  1. ;;Disabled
  1. ;;7014,"KEY")
  1. ;;ORB PROVIDER RECIPIENTS^DEA CERTIFICATE REVOKED
  1. ;;7014,"VAL")
  1. ;;OT
  1. ;;7015,"KEY")
  1. ;;ORB URGENCY^DEA CERTIFICATE REVOKED
  1. ;;7015,"VAL")
  1. ;;High
  1. ;;7016,"KEY")
  1. ;;ORB ARCHIVE PERIOD^DEA CERTIFICATE EXPIRED
  1. ;;7016,"VAL")
  1. ;;30
  1. ;;7017,"KEY")
  1. ;;ORB DELETE MECHANISM^DEA CERTIFICATE EXPIRED
  1. ;;7017,"VAL")
  1. ;;Individual Recipient
  1. ;;7018,"KEY")
  1. ;;ORB FORWARD BACKUP REVIEWER^DEA CERTIFICATE EXPIRED
  1. ;;7018,"VAL")
  1. ;;0
  1. ;;7019,"KEY")
  1. ;;ORB FORWARD SUPERVISOR^DEA CERTIFICATE EXPIRED
  1. ;;7019,"VAL")
  1. ;;0
  1. ;;7020,"KEY")
  1. ;;ORB FORWARD SURROGATES^DEA CERTIFICATE EXPIRED
  1. ;;7020,"VAL")
  1. ;;0
  1. ;;7021,"KEY")
  1. ;;ORB PROCESSING FLAG^DEA CERTIFICATE EXPIRED
  1. ;;7021,"VAL")
  1. ;;Disabled
  1. ;;7022,"KEY")
  1. ;;ORB PROVIDER RECIPIENTS^DEA CERTIFICATE EXPIRED
  1. ;;7022,"VAL")
  1. ;;O
  1. ;;7023,"KEY")
  1. ;;ORB URGENCY^DEA CERTIFICATE EXPIRED
  1. ;;7023,"VAL")
  1. ;;High