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

ORAMSET.m

Go to the documentation of this file.
  1. ORAMSET ; ISL/JER - Anticoagulation Setup ;11/20/14 11:12
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,361,391**;Dec 17, 1997;Build 11
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. Q
  1. ;
  1. ; External References:
  1. ; $$GET1^DIQ ICR #2056
  1. ; $$FMDIFF/$$NOW^XLFDT ICR #10103
  1. ; $$TITLE^XLFSTR ICR #10104
  1. ; $$GET^XPAR ICR #2263
  1. ; $$KSP^XUPARAM ICR #2541
  1. ;
  1. SET ; Enter Parameters
  1. N ORAMDIV,ORAMPARM,DIRUT,DUOUT,DTOUT,ORT0,ORAMTOUT K DIROUT
  1. S ORAMDIV=$$GETDIV Q:+ORAMDIV'>0
  1. S ORT0=$$NOW^XLFDT
  1. D TED^XPAREDIT("ORAM PARAMETERS","B",ORAMDIV) Q:+$G(DIROUT)!+$$TIMEOUT(ORT0)
  1. ; If Consult Link Enabled, ask Consult Request Service
  1. I +$$GET^XPAR(ORAMDIV,"ORAM CONSULT LINK ENABLED") D Q:+$D(DUOUT)!+$D(DTOUT)
  1. . S ORAMPARM=+$$GETPARM("ORAM CONSULT REQUEST SERVICE")_U_"Consult Request Service" Q:+ORAMPARM'>0
  1. . D EDIT^XPAREDIT(ORAMDIV,ORAMPARM)
  1. ; Ask PCE Link Enabled
  1. S ORAMPARM=+$$GETPARM("ORAM PCE LINK ENABLED")_U_"PCE Link Enabled" Q:+ORAMPARM'>0
  1. D EDIT^XPAREDIT(ORAMDIV,ORAMPARM) Q:+$G(DIROUT)!+$G(DIRUT)!+$D(DTOUT)
  1. ; Continue with PCE Parameter Template if TRUE
  1. I +$$GET^XPAR(ORAMDIV,"ORAM PCE LINK ENABLED") D Q:+$G(DIROUT)!+$G(ORAMTOUT)
  1. . S ORT0=$$NOW^XLFDT
  1. . D TED^XPAREDIT("ORAM PCE PARAMETERS","B",ORAMDIV)
  1. . S ORAMTOUT=$$TIMEOUT(ORT0)
  1. ; Continue with Letter Template
  1. D TED^XPAREDIT("ORAM LETTER PARAMETERS","B",ORAMDIV)
  1. Q
  1. ;
  1. SETDIV ; Enter Site Parameters
  1. N ORAMDIV,DIRUT,DUOUT,DTOUT K DIROUT
  1. S ORAMDIV=$$GETDIV Q:+ORAMDIV'>0
  1. D TED^XPAREDIT("ORAM SITE PARAMETERS","BA",ORAMDIV)
  1. Q
  1. ;
  1. SETCLIN ; Enter Clinic Parameters
  1. N ORAMCLIN,DIRUT,DUOUT,DTOUT K DIROUT
  1. S ORAMCLIN=$$SELLOC Q:+ORAMCLIN'>0
  1. D TED^XPAREDIT("ORAM CLINIC PARAMETERS","BA",ORAMCLIN)
  1. Q
  1. ;
  1. TIMEOUT(T0) ; Evaluate whether TED^XPAREDIT timed-out (since it NEWs DTOUT and DIRUT)
  1. Q $S($$FMDIFF^XLFDT($$NOW^XLFDT,T0,2)'<DTIME:1,1:0)
  1. ;
  1. GETCLINS(RESULT) ; Get Clinics
  1. N LIST,ERR,ORAME,ORAMI S ORAME="",ORAMI=0
  1. D ENVAL^XPAR(.LIST,"ORAM CLINIC NAME",1,.ERR)
  1. I 'LIST S RESULT(0)=0 Q
  1. F S ORAME=$O(LIST(ORAME)) Q:ORAME']"" D
  1. . N ORAMV S ORAMV=$G(LIST(ORAME,1)) Q:ORAMV']""
  1. . S ORAMI=ORAMI+1,RESULT(ORAMI)=ORAMV_U_ORAME
  1. . S RESULT(0)=ORAMI
  1. Q
  1. ;
  1. CLIN4PT(RESULT,ORAMDFN) ; Get the Clinic which is following the patient
  1. N ORAMCL
  1. S ORAMCL=$P($G(^ORAM(103,ORAMDFN,6)),U,2)
  1. S RESULT=$S(+ORAMCL>0:ORAMCL_";SC(",1:0)
  1. Q
  1. ;
  1. GET(RESULT,ORAMENT,ORVDT) ; Get Parameters
  1. N ADD1,ADD2,ADD3,DNOTE,ENOTE,INOTE,ATEAM,CBCQO,CTEAM,CFAX,CPHONE,ORAMALL,IMPLDT,ICDCP
  1. N CENAB,CSVC,CPLXPH,IVST,LTR,ORIENT,SMPLPH,SVST,DSSID,DSSUNIT,HCT,HCTNM,NLABTM,TOLLFREE
  1. N INRQO,MCNM,NCLOC,PCEON,PHCLIN,POCNM,RPATH,SIGNM,SIGTTL,SITENM,VLOC,PILLSTR,ICDC,DPIND
  1. N SICDC,DSIND,ICDCS
  1. S ORVDT=$G(ORVDT,DT),ICDCS="ICD-9-CM"
  1. S IMPLDT=$$IMPDATE^LEXU("10D")
  1. S ORAMENT=$S($G(ORAMENT)]"":$G(ORAMENT),1:"ALL"),DPIND=""
  1. S ORAMALL=$S(ORAMENT["ALL":ORAMENT,1:"ALL^"_ORAMENT)
  1. S ADD1=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 1",1,"I")
  1. S ADD2=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 2",1,"I")
  1. S ADD3=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 3",1,"I")
  1. S DNOTE=$$GET^XPAR(ORAMALL,"ORAM DISCHARGE NOTE",1,"I")
  1. S ENOTE=$$GET^XPAR(ORAMALL,"ORAM INTERIM NOTE",1,"I")
  1. S INOTE=$$GET^XPAR(ORAMALL,"ORAM INITIAL NOTE",1,"I")
  1. S ATEAM=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (ALL)",1,"I")
  1. S CTEAM=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (COMPLEX)",1,"I")
  1. S CBCQO=$$GET^XPAR(ORAMALL,"ORAM CBC QUICK ORDER",1,"I")
  1. S CFAX=$$GET^XPAR(ORAMENT,"ORAM CLINIC FAX NUMBER",1,"I")
  1. S CPHONE=$$GET^XPAR(ORAMENT,"ORAM CLINIC PHONE NUMBER",1,"I")
  1. S TOLLFREE=$$GET^XPAR(ORAMENT,"ORAM TOLL FREE PHONE",1,"I")
  1. S CENAB=$$GET^XPAR(ORAMENT,"ORAM CONSULT LINK ENABLED",1,"I")
  1. S CSVC=$$GET^XPAR(ORAMENT,"ORAM CONSULT REQUEST SERVICE",1,"E")
  1. S CPLXPH=$$GET^XPAR(ORAMALL,"ORAM CPT FOR COMPLEX PHONE",1,"I")
  1. S IVST=$$GET^XPAR(ORAMALL,"ORAM CPT FOR INITIAL VISIT",1,"I")
  1. S LTR=$$GET^XPAR(ORAMALL,"ORAM CPT FOR LETTER TO PT",1,"I")
  1. S ORIENT=$$GET^XPAR(ORAMALL,"ORAM CPT FOR ORIENTATION",1,"I")
  1. S SMPLPH=$$GET^XPAR(ORAMALL,"ORAM CPT FOR SIMPLE PHONE",1,"I")
  1. S SVST=$$GET^XPAR(ORAMALL,"ORAM CPT FOR SUBSEQUENT VISIT",1,"I")
  1. S DSSID=$$GET^XPAR(ORAMALL,"ORAM DSS ID",1,"I")
  1. S DSSUNIT=$$GET^XPAR(ORAMALL,"ORAM DSS UNIT",1,"I")
  1. S HCT=$$GET^XPAR(ORAMALL,"ORAM HCT/HGB REFERENCE",1,"B")
  1. S HCTNM=$P(HCT,U,2)
  1. S HCT=$P(HCT,U)
  1. S INRQO=$$GET^XPAR(ORAMALL,"ORAM INR QUICK ORDER",1,"I")
  1. S MCNM=$$GET^XPAR(ORAMALL,"ORAM MEDICAL CENTER NAME",1,"I")
  1. S NCLOC=$$GET^XPAR(ORAMENT,"ORAM NON-COUNT LOCATION",1,"I")
  1. S PCEON=$$GET^XPAR(ORAMENT,"ORAM PCE LINK ENABLED",1,"I")
  1. ; If I10 not yet implemented use I9 auto-prim indic, else use I10
  1. I (IMPLDT>ORVDT) D I 1
  1. . S ICDC=$$GET^XPAR(ORAMENT,"ORAM AUTO PRIMARY INDICATION",1,"E"),ICDCS="ICD-9-CM"
  1. E D
  1. . S ICDC=$$GET^XPAR(ORAMENT,"ORAM I10 AUTO PRIM INDICATION",1,"E"),ICDCS="ICD-10-CM"
  1. I ICDC]"" D I 1
  1. . N ICDDESC
  1. . D ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,DT,.ICDDESC)
  1. . S DPIND=ICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_ICDCS_" "_ICDC_")"
  1. E S DPIND="^"
  1. ; If I10 not yet implemented use I9 auto-secondary indic, else use I10
  1. I (IMPLDT>ORVDT) D I 1
  1. . S SICDC=$$GET^XPAR(ORAMENT,"ORAM AUTO SECONDARY INDICATION",1,"E"),ICDCS="ICD-9-CM"
  1. E D
  1. . S SICDC=$$GET^XPAR(ORAMENT,"ORAM I10 AUTO SEC INDICATION",1,"E"),ICDCS="ICD-10-CM"
  1. I SICDC]"" D I 1
  1. . N ICDDESC
  1. . D ICDDESC^ICDXCODE("DIAGNOSIS",SICDC,DT,.ICDDESC)
  1. . S DSIND=SICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_ICDCS_" "_SICDC_")"
  1. E S DSIND="^"
  1. S PHCLIN=$$GET^XPAR(ORAMENT,"ORAM PHONE CLINIC",1,"I")
  1. S PILLSTR=$$GET^XPAR(ORAMENT,"ORAM DEFAULT PILL STRENGTH",1,"I")
  1. S NLABTM=$$GET^XPAR(ORAMENT,"ORAM INCL TIME W/NEXT INR DATE",1,"I")
  1. S POCNM=$$GET^XPAR(ORAMENT,"ORAM POINT OF CONTACT NAME",1,"I")
  1. S RPATH=$$GET^XPAR(ORAMALL,"ORAM RAV FILE PATH",1,"I")
  1. S SIGNM=$$GET^XPAR(ORAMENT,"ORAM SIGNATURE BLOCK NAME",1,"I")
  1. S SIGTTL=$$GET^XPAR(ORAMENT,"ORAM SIGNATURE BLOCK TITLE",1,"I")
  1. S SITENM=$$GET^XPAR(ORAMENT,"ORAM CLINIC NAME",1,"I")
  1. S VLOC=$$GET^XPAR(ORAMENT,"ORAM VISIT LOCATION",1,"I")
  1. S RESULT(0)=SITENM_U_ATEAM_U_CTEAM_U_INOTE_U_ENOTE_U_DNOTE_U_SMPLPH_U_SVST_U_CPLXPH_U_ORIENT_U_IVST_U_CENAB_U_PCEON_U_LTR_U_U_ADD1_U_ADD2_U_ADD3
  1. S RESULT(1)=SIGNM_U_SIGTTL_U_POCNM_U_CPHONE_"|"_CFAX_U_MCNM_U_PILLSTR_U_NLABTM_U_TOLLFREE
  1. S RESULT(2)=VLOC_"|"_PHCLIN_"|"_NCLOC_U_INRQO_"|"_CBCQO_U_DUZ(2)_U_DSSUNIT_U_DSSID_U_CSVC_U_HCT_"|"_HCTNM_U_RPATH_U_DPIND_U_(IMPLDT'>ORVDT)
  1. S RESULT(3)=DSIND
  1. Q
  1. ;
  1. INDICS(RESULT,ORVDT) ; RPC To Get indications for care
  1. N IMPLDT
  1. S ORVDT=$G(ORVDT,DT)
  1. S IMPLDT=$$IMPDATE^LEXU("10D")
  1. ; If I10 not yet implemented use I9 auto-prim indic, else use I10
  1. I (IMPLDT>ORVDT) D I 1
  1. . D GETLST^XPAR(.RESULT,"SYS^PKG","ORAM INDICATIONS FOR CARE","E")
  1. E D
  1. . D GETLST^XPAR(.RESULT,"SYS^PKG","ORAM I10 INDICATIONS FOR CARE","E")
  1. I +RESULT'>0 S RESULT(0)=0
  1. Q
  1. ;
  1. GETDIV() ; get division
  1. N DIV,ORAMY
  1. S DIV=$$KSP^XUPARAM("INST"),ORAMY=0
  1. I $$GET1^DIQ(4,DIV_",",5,"I")'="Y" S ORAMY=DIV_";DIC(4," I 1
  1. E S ORAMY=$$SELDIV
  1. Q ORAMY
  1. SELDIV() ; select division
  1. N DIC,X,Y
  1. W !!,"Enter Anticoagulation Management Parameters by Division:",!
  1. S DIC=4,DIC(0)="AEMQ",DIC("S")="I +$O(^DG(40.8,""AD"",+Y,0))"
  1. D ^DIC S:+Y>0 Y=+Y_";DIC(4,"
  1. Q Y
  1. SELLOC() ; select hospital location
  1. N DIC,X,Y,TIUAPDT S DIC=44,DIC(0)="AEMQ"
  1. S DIC("A")="Select CLINIC: "
  1. S DIC("S")="I $$GOODLOC^ORAMSET(Y)"
  1. D ^DIC K DIC("S") S:+Y>0 Y=+Y_";SC("
  1. Q Y
  1. GOODLOC(LOC) ; Returns 1 if ^SC hospital location IFN LOC is good, else 0
  1. N GOODLOC,INACTIVE,OOS,CLINIC,NONCOUNT S (GOODLOC,INACTIVE,NONCOUNT)=0
  1. I +$G(^SC(LOC,"I"))>0,(+$G(^("I"))'>DT) D
  1. . S INACTIVE=1
  1. . ; check if reactivated:
  1. . I +$P($G(^("I")),U,2)>0,$P($G(^("I")),U,2)'>DT S INACTIVE=0
  1. S OOS=+$D(^SC(LOC,"OOS")) ; Occasion of service
  1. S CLINIC=+($P(^SC(LOC,0),U,3)="C")
  1. S NONCOUNT=$S($P(^SC(LOC,0),U,17)="Y":1,1:0)
  1. I 'INACTIVE,'OOS,'NONCOUNT,CLINIC S GOODLOC=1
  1. Q GOODLOC
  1. GETPARM(X) ; Get parameter as IEN^NAME
  1. N DIC,Y S DIC=8989.51,DIC(0)="MQ"
  1. D ^DIC
  1. Q Y
  1. GETCMPDT(CODESYS) ; Returns compare date for indication set-up
  1. N Y,IDT
  1. S CODESYS=$G(CODESYS,"10D"),Y=DT
  1. S IDT=$$IMPDATE^LEXU("10D")
  1. S Y=$S(CODESYS="10D":IDT,1:+$$FMADD^XLFDT(IDT,-1))
  1. Q Y
  1. ISCODEOK(CODE,CODESYS) ; Boolean - is code active as of compare date for code system
  1. N Y,CDT,CODESTAT
  1. S CODESYS=$G(CODESYS,"10D"),Y=0
  1. S CDT=$$GETCMPDT(CODESYS)
  1. S CODESTAT=$$STATCHK^ICDEX(CODE,CDT,CODESYS)
  1. I +CODESTAT=1,(+$P(CODESTAT,U,3)>0),($P(CODESTAT,U,3)'>CDT) S Y=1
  1. Q Y