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

ORIN1010.m

Go to the documentation of this file.
  1. ORIN1010 ;IHS/CIA/PLS - KIDS Inits for OR patch 1010 ;07-Mar-2013 13:41;PLS
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1010**;Dec 17, 1997;Build 47
  1. ;=================================================================
  1. EC ;EP - Environment check
  1. Q
  1. PRE ;EP - Preinit
  1. ;D CHGPSO
  1. Q
  1. POST ;EP - Postinit
  1. N PKG
  1. F PKG="LAB SERVICE","OUTPATIENT PHARMACY","PHARMACY DATA MANAGEMENT" D
  1. .D ADDPMT("OR GTX CLININD",PKG,"Indication:","clinical indicator",10,99,"%40")
  1. .D ADDPMT("OR GTX CLININD2",PKG,"Indication ICD9:","clinical indicator ICD9",10.5,-1)
  1. .Q:PKG="LAB SERVICE"
  1. .D ADDPMT("OR GTX CMF",PKG,"Chronic Med:","chronic med",4.7,10)
  1. .D ADDPMT("OR GTX DAW",PKG,"Dispense as Written:","dispense as written",4.8,10.1)
  1. .D ADDPMT("OR GTX PHARMACY",PKG,"Pharmacy:","pharmacy",7.1,99)
  1. .D ADDPMT("OR GTX SSREFREQ",PKG,"REFREQ Msg:","REFREQ Msg",7.2,99.1,"@",0)
  1. .D ADDPMT("OR GTX SSRREQIEN",PKG,"REFREQ IEN:","REFREQ IEN",7.3,99.2,"@")
  1. .D ADDPMT("OR GTX SSDENYRSN",PKG,"Reason to Deny:","Reason to Deny",7.4,99.3,"@")
  1. D REMPRG
  1. D ADDCHILD("BEHOEN VISIT SUMMARY1")
  1. D ADDCHILD("BEHOEN VISIT SUMMARY2")
  1. D ADDCHILD("BEHOEN VISIT SUMMARIES")
  1. D CHGMXNM("OUTPATIENT MEDICATIONS","Outpt. Meds")
  1. D CHGERX
  1. D CHGODDM("OR GTX DAYS SUPPLY","1:365")
  1. D CHGODDM("OR GTX QUANTITY",".01:99999999.99:3")
  1. D HERB
  1. D CHGPSO
  1. Q
  1. ;
  1. CHGPSO ;EP-
  1. N DNM
  1. F DNM="PSO OERR","LR OTHER LAB TESTS" D CHKPSO1(DNM)
  1. Q
  1. CHKPSO1(DNM) ;EP-
  1. N DLG,PMT,IEN,FDA
  1. S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
  1. S PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX CLININD")
  1. Q:'PMT!'DLG
  1. S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
  1. Q:'IEN
  1. S FDA(101.412,IEN_","_DLG_",",9)="@"
  1. D FILE^DIE("","FDA")
  1. Q
  1. ; Change domain value of given order dialog
  1. CHGODDM(DLGNM,DMVAL) ;EP-
  1. N DLG,FDA
  1. S DLG=$$FIND1^DIC(101.41,,"XQ",DLGNM)
  1. Q:'DLG
  1. S FDA(101.41,DLG_",",12)=DMVAL
  1. D FILE^DIE("","FDA")
  1. Q
  1. ; Add a report to the ORRPW ADT VISITS report header.
  1. ADDCHILD(RPT) ;
  1. N X,Y,FDA
  1. S X=$$FIND1^DIC(101.24,,"X","ORRPW ADT VISITS")
  1. S Y=$$FIND1^DIC(101.24,,"X",RPT)
  1. I X,Y D
  1. .S:'$O(^ORD(101.24,X,10,"B",Y,0)) FDA(101.241,"+1,"_X_",",.01)="`"_Y
  1. .S FDA(101.24,Y_",",.13)="ORWRP REPORT TEXT"
  1. .D UPDATE^DIE("E","FDA")
  1. Q
  1. ; Add prompt to selected order and quick order dialogs
  1. ADDPMT(PMT,PKG,LBL,DX,SEQ,OTS,FMT,REQ) ;
  1. N DLG,TYP,ITM,QO,X,Y
  1. S REQ=$G(REQ,1)
  1. S:PMT'=+PMT PMT=$$FIND1^DIC(101.41,,"XQ",PMT)
  1. S:PKG'=+PKG PKG=$$FIND1^DIC(9.4,,"XQ",PKG)
  1. Q:'PMT!'PKG
  1. S QO='OTS,TYP=$S(QO:"Q",1:"D"),ITM=0,FMT=$G(FMT)
  1. F DLG=0:0 S DLG=$O(^ORD(101.41,DLG)) Q:'DLG S X=$G(^(DLG,0)) D
  1. .N FDA,IEN,NAM,SUB,SFN
  1. .Q:$P(X,U,4)'=TYP
  1. .S Y=$P(X,U,7)
  1. .I 'Y,QO D
  1. ..S Y=$P(X,U,5)
  1. ..S:Y Y=$P($G(^ORD(100.98,Y,0)),U,4)
  1. ..S:Y Y=$P($G(^ORD(101.41,Y,0)),U,7)
  1. .Q:Y'=PKG
  1. .S SUB=$S(QO:6,1:10),SFN=$S(QO:101.416,1:101.412)
  1. .Q:'$O(^ORD(101.41,DLG,SUB,"D",0))
  1. .S IEN=$O(^ORD(101.41,DLG,SUB,"D",PMT,0))
  1. .S NAM=$$GET1^DIQ(101.41,DLG,.01)
  1. .S FDA=$NA(FDA(SFN,$S(IEN:IEN,1:"+1")_","_DLG_","))
  1. .D ADDQO:QO,ADDDG:'QO
  1. .D UPDATE^DIE("","FDA","IEN")
  1. .S X=$S(IEN:IEN,1:+$G(IEN(1)))
  1. .S:'ITM ITM=X
  1. .D BMES^XPDUTL($S(IEN:"Updated ",X:"Added ",1:"Unable to add ")_DX_" prompt "_$S(IEN:"in ",1:"to ")_NAM_".")
  1. I 'QO,ITM D ADDPMT(PMT,PKG,LBL,DX,ITM,0)
  1. Q
  1. ADDDG S @FDA@(.01)=SEQ
  1. S @FDA@(2)=PMT
  1. S @FDA@(6)=REQ ;required field
  1. S @FDA@(9)="*"
  1. S @FDA@(17)="S Y="""""
  1. S:OTS>0 @FDA@(21)=OTS
  1. S:$L(FMT) @FDA@(22)=FMT
  1. S @FDA@(24)=LBL
  1. Q
  1. ADDQO S @FDA@(.01)=SEQ
  1. S @FDA@(.02)=PMT
  1. S @FDA@(.03)=1
  1. Q
  1. ; Change Mixed Name field value for Display Group
  1. CHGMXNM(DSPGRP,MXNM) ;
  1. N FDA,IEN
  1. Q:'$L($G(DSPGRP))!('$L($G(MXNM)))
  1. S IEN=$$FIND1^DIC(100.98,,"XQ",DSPGRP)
  1. Q:'IEN
  1. S FDA(100.98,IEN_",",2)=MXNM
  1. D FILE^DIE("","FDA")
  1. Q
  1. ; Remove ORPF GRACE DAYS BEFORE PURGE parameter from
  1. ; ORP ORDER MISC parameter template
  1. REMPRG N PAR,TPL,LP,FDA
  1. S PAR=$$FIND1^DIC(8989.51,,"XQ","ORPF GRACE DAYS BEFORE PURGE")
  1. S TPL=$$FIND1^DIC(8989.52,,"XQ","ORP ORDER MISC")
  1. Q:'PAR!'TPL
  1. F LP=0:0 S LP=$O(^XTV(8989.52,TPL,10,LP)) Q:'LP D:$P($G(^(LP,0)),U,2)=PAR
  1. .S FDA(8989.521,LP_","_TPL_",",.01)="@"
  1. D:$D(FDA) FILE^DIE("","FDA")
  1. Q
  1. ; Attach prompts to Herbal dialog
  1. HERB ;EP-
  1. F PKG="HERBAL/OTC/NON-VA MEDS" D
  1. .D ADDPMT("OR GTX HM LAST DOSE TAKEN",PKG,"Last Dose Taken:","last dose taken",12.1,12.1,"5Z")
  1. .D ADDPMT("OR GTX HM LOCATION OF MEDICATION",PKG,"Medication Location:","medication location",12.2,12.2)
  1. .D ADDPMT("OR GTX HM LIST SOURCE",PKG,"Home Medication Source:","home medication source",12.3,12.3)
  1. .D ADDPMT("OR GTX HM REASON",PKG,"Reason for Medication:","reason for medication",12.4,12.4)
  1. Q
  1. ; File entry
  1. STORE(FDA) ;EP
  1. N MSG
  1. D UPDATE^DIE(,"FDA",,"MSG")
  1. I $D(MSG) D
  1. .W !,"The following error occurred:"
  1. .W !,$G(MSG("DIERR",1,"TEXT",1))
  1. .S XPDQUIT=1
  1. K FDA
  1. Q
  1. ;
  1. TRAN(VAL) ;EP - Check for entry inclusion
  1. I "^OR GTX HM LIST SOURCE^OR GTX SSREFREQ^"[VAL Q 1
  1. Q 0
  1. ;
  1. ADDRDIV ;
  1. Q:$$FIND1^DIC(100.22,,,"REQUESTING DIVISION") ; Already exists
  1. N FDA,FN,IEN
  1. S IEN=$P(^ORD(100.22,0),U,3) ; Check next ien value. Set to 1 if not between 1 and 999
  1. S:IEN>999 $P(^ORD(100.22,0),U,3)=0 ; Move range of new entries to start with 1(or the next valid ien)
  1. S FN=100.22,IEN="+1,"
  1. S FDA(FN,IEN,.01)="REQUESTING DIVISION"
  1. S FDA(FN,IEN,.02)="DIV:"
  1. S FDA(FN,IEN,.03)="TEST LOCATION"
  1. S FDA(FN,IEN,.04)="ORPRDIV"
  1. S FDA(FN,IEN,1)="S ORPRDIV="""" I $P($G(^OR(100,+$G(ORIFN),0)),U,10) S ORPRDIV=$P(^SC(+$P(^(0),U,10),0),U,15) I ORPRDIV'="""" S ORPRDIV=$P($G(^DG(40.8,ORPRDIV,0)),U,1)"
  1. D STORE(.FDA)
  1. Q
  1. ;
  1. ; Change ERX ORDER instance value for ORB URGENCY
  1. CHGERX ; EP-
  1. N ERR
  1. D DEL^XPAR("PKG","ORB URGENCY","ERX ORDER",.ERR)
  1. D ADD^XPAR("PKG","ORB URGENCY","ERX ORDER",1,.ERR)
  1. Q