ORAMSET ; ISL/JER - Anticoagulation Setup ;11/20/14 11:12
;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,361,391**;Dec 17, 1997;Build 11
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
; External References:
; $$GET1^DIQ ICR #2056
; $$FMDIFF/$$NOW^XLFDT ICR #10103
; $$TITLE^XLFSTR ICR #10104
; $$GET^XPAR ICR #2263
; $$KSP^XUPARAM ICR #2541
;
SET ; Enter Parameters
N ORAMDIV,ORAMPARM,DIRUT,DUOUT,DTOUT,ORT0,ORAMTOUT K DIROUT
S ORAMDIV=$$GETDIV Q:+ORAMDIV'>0
S ORT0=$$NOW^XLFDT
D TED^XPAREDIT("ORAM PARAMETERS","B",ORAMDIV) Q:+$G(DIROUT)!+$$TIMEOUT(ORT0)
; If Consult Link Enabled, ask Consult Request Service
I +$$GET^XPAR(ORAMDIV,"ORAM CONSULT LINK ENABLED") D Q:+$D(DUOUT)!+$D(DTOUT)
. S ORAMPARM=+$$GETPARM("ORAM CONSULT REQUEST SERVICE")_U_"Consult Request Service" Q:+ORAMPARM'>0
. D EDIT^XPAREDIT(ORAMDIV,ORAMPARM)
; Ask PCE Link Enabled
S ORAMPARM=+$$GETPARM("ORAM PCE LINK ENABLED")_U_"PCE Link Enabled" Q:+ORAMPARM'>0
D EDIT^XPAREDIT(ORAMDIV,ORAMPARM) Q:+$G(DIROUT)!+$G(DIRUT)!+$D(DTOUT)
; Continue with PCE Parameter Template if TRUE
I +$$GET^XPAR(ORAMDIV,"ORAM PCE LINK ENABLED") D Q:+$G(DIROUT)!+$G(ORAMTOUT)
. S ORT0=$$NOW^XLFDT
. D TED^XPAREDIT("ORAM PCE PARAMETERS","B",ORAMDIV)
. S ORAMTOUT=$$TIMEOUT(ORT0)
; Continue with Letter Template
D TED^XPAREDIT("ORAM LETTER PARAMETERS","B",ORAMDIV)
Q
;
SETDIV ; Enter Site Parameters
N ORAMDIV,DIRUT,DUOUT,DTOUT K DIROUT
S ORAMDIV=$$GETDIV Q:+ORAMDIV'>0
D TED^XPAREDIT("ORAM SITE PARAMETERS","BA",ORAMDIV)
Q
;
SETCLIN ; Enter Clinic Parameters
N ORAMCLIN,DIRUT,DUOUT,DTOUT K DIROUT
S ORAMCLIN=$$SELLOC Q:+ORAMCLIN'>0
D TED^XPAREDIT("ORAM CLINIC PARAMETERS","BA",ORAMCLIN)
Q
;
TIMEOUT(T0) ; Evaluate whether TED^XPAREDIT timed-out (since it NEWs DTOUT and DIRUT)
Q $S($$FMDIFF^XLFDT($$NOW^XLFDT,T0,2)'<DTIME:1,1:0)
;
GETCLINS(RESULT) ; Get Clinics
N LIST,ERR,ORAME,ORAMI S ORAME="",ORAMI=0
D ENVAL^XPAR(.LIST,"ORAM CLINIC NAME",1,.ERR)
I 'LIST S RESULT(0)=0 Q
F S ORAME=$O(LIST(ORAME)) Q:ORAME']"" D
. N ORAMV S ORAMV=$G(LIST(ORAME,1)) Q:ORAMV']""
. S ORAMI=ORAMI+1,RESULT(ORAMI)=ORAMV_U_ORAME
. S RESULT(0)=ORAMI
Q
;
CLIN4PT(RESULT,ORAMDFN) ; Get the Clinic which is following the patient
N ORAMCL
S ORAMCL=$P($G(^ORAM(103,ORAMDFN,6)),U,2)
S RESULT=$S(+ORAMCL>0:ORAMCL_";SC(",1:0)
Q
;
GET(RESULT,ORAMENT,ORVDT) ; Get Parameters
N ADD1,ADD2,ADD3,DNOTE,ENOTE,INOTE,ATEAM,CBCQO,CTEAM,CFAX,CPHONE,ORAMALL,IMPLDT,ICDCP
N CENAB,CSVC,CPLXPH,IVST,LTR,ORIENT,SMPLPH,SVST,DSSID,DSSUNIT,HCT,HCTNM,NLABTM,TOLLFREE
N INRQO,MCNM,NCLOC,PCEON,PHCLIN,POCNM,RPATH,SIGNM,SIGTTL,SITENM,VLOC,PILLSTR,ICDC,DPIND
N SICDC,DSIND,ICDCS
S ORVDT=$G(ORVDT,DT),ICDCS="ICD-9-CM"
S IMPLDT=$$IMPDATE^LEXU("10D")
S ORAMENT=$S($G(ORAMENT)]"":$G(ORAMENT),1:"ALL"),DPIND=""
S ORAMALL=$S(ORAMENT["ALL":ORAMENT,1:"ALL^"_ORAMENT)
S ADD1=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 1",1,"I")
S ADD2=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 2",1,"I")
S ADD3=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 3",1,"I")
S DNOTE=$$GET^XPAR(ORAMALL,"ORAM DISCHARGE NOTE",1,"I")
S ENOTE=$$GET^XPAR(ORAMALL,"ORAM INTERIM NOTE",1,"I")
S INOTE=$$GET^XPAR(ORAMALL,"ORAM INITIAL NOTE",1,"I")
S ATEAM=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (ALL)",1,"I")
S CTEAM=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (COMPLEX)",1,"I")
S CBCQO=$$GET^XPAR(ORAMALL,"ORAM CBC QUICK ORDER",1,"I")
S CFAX=$$GET^XPAR(ORAMENT,"ORAM CLINIC FAX NUMBER",1,"I")
S CPHONE=$$GET^XPAR(ORAMENT,"ORAM CLINIC PHONE NUMBER",1,"I")
S TOLLFREE=$$GET^XPAR(ORAMENT,"ORAM TOLL FREE PHONE",1,"I")
S CENAB=$$GET^XPAR(ORAMENT,"ORAM CONSULT LINK ENABLED",1,"I")
S CSVC=$$GET^XPAR(ORAMENT,"ORAM CONSULT REQUEST SERVICE",1,"E")
S CPLXPH=$$GET^XPAR(ORAMALL,"ORAM CPT FOR COMPLEX PHONE",1,"I")
S IVST=$$GET^XPAR(ORAMALL,"ORAM CPT FOR INITIAL VISIT",1,"I")
S LTR=$$GET^XPAR(ORAMALL,"ORAM CPT FOR LETTER TO PT",1,"I")
S ORIENT=$$GET^XPAR(ORAMALL,"ORAM CPT FOR ORIENTATION",1,"I")
S SMPLPH=$$GET^XPAR(ORAMALL,"ORAM CPT FOR SIMPLE PHONE",1,"I")
S SVST=$$GET^XPAR(ORAMALL,"ORAM CPT FOR SUBSEQUENT VISIT",1,"I")
S DSSID=$$GET^XPAR(ORAMALL,"ORAM DSS ID",1,"I")
S DSSUNIT=$$GET^XPAR(ORAMALL,"ORAM DSS UNIT",1,"I")
S HCT=$$GET^XPAR(ORAMALL,"ORAM HCT/HGB REFERENCE",1,"B")
S HCTNM=$P(HCT,U,2)
S HCT=$P(HCT,U)
S INRQO=$$GET^XPAR(ORAMALL,"ORAM INR QUICK ORDER",1,"I")
S MCNM=$$GET^XPAR(ORAMALL,"ORAM MEDICAL CENTER NAME",1,"I")
S NCLOC=$$GET^XPAR(ORAMENT,"ORAM NON-COUNT LOCATION",1,"I")
S PCEON=$$GET^XPAR(ORAMENT,"ORAM PCE LINK ENABLED",1,"I")
; If I10 not yet implemented use I9 auto-prim indic, else use I10
I (IMPLDT>ORVDT) D I 1
. S ICDC=$$GET^XPAR(ORAMENT,"ORAM AUTO PRIMARY INDICATION",1,"E"),ICDCS="ICD-9-CM"
E D
. S ICDC=$$GET^XPAR(ORAMENT,"ORAM I10 AUTO PRIM INDICATION",1,"E"),ICDCS="ICD-10-CM"
I ICDC]"" D I 1
. N ICDDESC
. D ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,DT,.ICDDESC)
. S DPIND=ICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_ICDCS_" "_ICDC_")"
E S DPIND="^"
; If I10 not yet implemented use I9 auto-secondary indic, else use I10
I (IMPLDT>ORVDT) D I 1
. S SICDC=$$GET^XPAR(ORAMENT,"ORAM AUTO SECONDARY INDICATION",1,"E"),ICDCS="ICD-9-CM"
E D
. S SICDC=$$GET^XPAR(ORAMENT,"ORAM I10 AUTO SEC INDICATION",1,"E"),ICDCS="ICD-10-CM"
I SICDC]"" D I 1
. N ICDDESC
. D ICDDESC^ICDXCODE("DIAGNOSIS",SICDC,DT,.ICDDESC)
. S DSIND=SICDC_U_$$TITLE^XLFSTR($G(ICDDESC(1)))_" ("_ICDCS_" "_SICDC_")"
E S DSIND="^"
S PHCLIN=$$GET^XPAR(ORAMENT,"ORAM PHONE CLINIC",1,"I")
S PILLSTR=$$GET^XPAR(ORAMENT,"ORAM DEFAULT PILL STRENGTH",1,"I")
S NLABTM=$$GET^XPAR(ORAMENT,"ORAM INCL TIME W/NEXT INR DATE",1,"I")
S POCNM=$$GET^XPAR(ORAMENT,"ORAM POINT OF CONTACT NAME",1,"I")
S RPATH=$$GET^XPAR(ORAMALL,"ORAM RAV FILE PATH",1,"I")
S SIGNM=$$GET^XPAR(ORAMENT,"ORAM SIGNATURE BLOCK NAME",1,"I")
S SIGTTL=$$GET^XPAR(ORAMENT,"ORAM SIGNATURE BLOCK TITLE",1,"I")
S SITENM=$$GET^XPAR(ORAMENT,"ORAM CLINIC NAME",1,"I")
S VLOC=$$GET^XPAR(ORAMENT,"ORAM VISIT LOCATION",1,"I")
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
S RESULT(1)=SIGNM_U_SIGTTL_U_POCNM_U_CPHONE_"|"_CFAX_U_MCNM_U_PILLSTR_U_NLABTM_U_TOLLFREE
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)
S RESULT(3)=DSIND
Q
;
INDICS(RESULT,ORVDT) ; RPC To Get indications for care
N IMPLDT
S ORVDT=$G(ORVDT,DT)
S IMPLDT=$$IMPDATE^LEXU("10D")
; If I10 not yet implemented use I9 auto-prim indic, else use I10
I (IMPLDT>ORVDT) D I 1
. D GETLST^XPAR(.RESULT,"SYS^PKG","ORAM INDICATIONS FOR CARE","E")
E D
. D GETLST^XPAR(.RESULT,"SYS^PKG","ORAM I10 INDICATIONS FOR CARE","E")
I +RESULT'>0 S RESULT(0)=0
Q
;
GETDIV() ; get division
N DIV,ORAMY
S DIV=$$KSP^XUPARAM("INST"),ORAMY=0
I $$GET1^DIQ(4,DIV_",",5,"I")'="Y" S ORAMY=DIV_";DIC(4," I 1
E S ORAMY=$$SELDIV
Q ORAMY
SELDIV() ; select division
N DIC,X,Y
W !!,"Enter Anticoagulation Management Parameters by Division:",!
S DIC=4,DIC(0)="AEMQ",DIC("S")="I +$O(^DG(40.8,""AD"",+Y,0))"
D ^DIC S:+Y>0 Y=+Y_";DIC(4,"
Q Y
SELLOC() ; select hospital location
N DIC,X,Y,TIUAPDT S DIC=44,DIC(0)="AEMQ"
S DIC("A")="Select CLINIC: "
S DIC("S")="I $$GOODLOC^ORAMSET(Y)"
D ^DIC K DIC("S") S:+Y>0 Y=+Y_";SC("
Q Y
GOODLOC(LOC) ; Returns 1 if ^SC hospital location IFN LOC is good, else 0
N GOODLOC,INACTIVE,OOS,CLINIC,NONCOUNT S (GOODLOC,INACTIVE,NONCOUNT)=0
I +$G(^SC(LOC,"I"))>0,(+$G(^("I"))'>DT) D
. S INACTIVE=1
. ; check if reactivated:
. I +$P($G(^("I")),U,2)>0,$P($G(^("I")),U,2)'>DT S INACTIVE=0
S OOS=+$D(^SC(LOC,"OOS")) ; Occasion of service
S CLINIC=+($P(^SC(LOC,0),U,3)="C")
S NONCOUNT=$S($P(^SC(LOC,0),U,17)="Y":1,1:0)
I 'INACTIVE,'OOS,'NONCOUNT,CLINIC S GOODLOC=1
Q GOODLOC
GETPARM(X) ; Get parameter as IEN^NAME
N DIC,Y S DIC=8989.51,DIC(0)="MQ"
D ^DIC
Q Y
GETCMPDT(CODESYS) ; Returns compare date for indication set-up
N Y,IDT
S CODESYS=$G(CODESYS,"10D"),Y=DT
S IDT=$$IMPDATE^LEXU("10D")
S Y=$S(CODESYS="10D":IDT,1:+$$FMADD^XLFDT(IDT,-1))
Q Y
ISCODEOK(CODE,CODESYS) ; Boolean - is code active as of compare date for code system
N Y,CDT,CODESTAT
S CODESYS=$G(CODESYS,"10D"),Y=0
S CDT=$$GETCMPDT(CODESYS)
S CODESTAT=$$STATCHK^ICDEX(CODE,CDT,CODESYS)
I +CODESTAT=1,(+$P(CODESTAT,U,3)>0),($P(CODESTAT,U,3)'>CDT) S Y=1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORAMSET 8562 printed Dec 13, 2024@02:27:07 Page 2
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
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
+5 ; External References:
+6 ; $$GET1^DIQ ICR #2056
+7 ; $$FMDIFF/$$NOW^XLFDT ICR #10103
+8 ; $$TITLE^XLFSTR ICR #10104
+9 ; $$GET^XPAR ICR #2263
+10 ; $$KSP^XUPARAM ICR #2541
+11 ;
SET ; Enter Parameters
+1 NEW ORAMDIV,ORAMPARM,DIRUT,DUOUT,DTOUT,ORT0,ORAMTOUT
KILL DIROUT
+2 SET ORAMDIV=$$GETDIV
if +ORAMDIV'>0
QUIT
+3 SET ORT0=$$NOW^XLFDT
+4 DO TED^XPAREDIT("ORAM PARAMETERS","B",ORAMDIV)
if +$GET(DIROUT)!+$$TIMEOUT(ORT0)
QUIT
+5 ; If Consult Link Enabled, ask Consult Request Service
+6 IF +$$GET^XPAR(ORAMDIV,"ORAM CONSULT LINK ENABLED")
Begin DoDot:1
+7 SET ORAMPARM=+$$GETPARM("ORAM CONSULT REQUEST SERVICE")_U_"Consult Request Service"
if +ORAMPARM'>0
QUIT
+8 DO EDIT^XPAREDIT(ORAMDIV,ORAMPARM)
End DoDot:1
if +$DATA(DUOUT)!+$DATA(DTOUT)
QUIT
+9 ; Ask PCE Link Enabled
+10 SET ORAMPARM=+$$GETPARM("ORAM PCE LINK ENABLED")_U_"PCE Link Enabled"
if +ORAMPARM'>0
QUIT
+11 DO EDIT^XPAREDIT(ORAMDIV,ORAMPARM)
if +$GET(DIROUT)!+$GET(DIRUT)!+$DATA(DTOUT)
QUIT
+12 ; Continue with PCE Parameter Template if TRUE
+13 IF +$$GET^XPAR(ORAMDIV,"ORAM PCE LINK ENABLED")
Begin DoDot:1
+14 SET ORT0=$$NOW^XLFDT
+15 DO TED^XPAREDIT("ORAM PCE PARAMETERS","B",ORAMDIV)
+16 SET ORAMTOUT=$$TIMEOUT(ORT0)
End DoDot:1
if +$GET(DIROUT)!+$GET(ORAMTOUT)
QUIT
+17 ; Continue with Letter Template
+18 DO TED^XPAREDIT("ORAM LETTER PARAMETERS","B",ORAMDIV)
+19 QUIT
+20 ;
SETDIV ; Enter Site Parameters
+1 NEW ORAMDIV,DIRUT,DUOUT,DTOUT
KILL DIROUT
+2 SET ORAMDIV=$$GETDIV
if +ORAMDIV'>0
QUIT
+3 DO TED^XPAREDIT("ORAM SITE PARAMETERS","BA",ORAMDIV)
+4 QUIT
+5 ;
SETCLIN ; Enter Clinic Parameters
+1 NEW ORAMCLIN,DIRUT,DUOUT,DTOUT
KILL DIROUT
+2 SET ORAMCLIN=$$SELLOC
if +ORAMCLIN'>0
QUIT
+3 DO TED^XPAREDIT("ORAM CLINIC PARAMETERS","BA",ORAMCLIN)
+4 QUIT
+5 ;
TIMEOUT(T0) ; Evaluate whether TED^XPAREDIT timed-out (since it NEWs DTOUT and DIRUT)
+1 QUIT $SELECT($$FMDIFF^XLFDT($$NOW^XLFDT,T0,2)'<DTIME:1,1:0)
+2 ;
GETCLINS(RESULT) ; Get Clinics
+1 NEW LIST,ERR,ORAME,ORAMI
SET ORAME=""
SET ORAMI=0
+2 DO ENVAL^XPAR(.LIST,"ORAM CLINIC NAME",1,.ERR)
+3 IF 'LIST
SET RESULT(0)=0
QUIT
+4 FOR
SET ORAME=$ORDER(LIST(ORAME))
if ORAME']""
QUIT
Begin DoDot:1
+5 NEW ORAMV
SET ORAMV=$GET(LIST(ORAME,1))
if ORAMV']""
QUIT
+6 SET ORAMI=ORAMI+1
SET RESULT(ORAMI)=ORAMV_U_ORAME
+7 SET RESULT(0)=ORAMI
End DoDot:1
+8 QUIT
+9 ;
CLIN4PT(RESULT,ORAMDFN) ; Get the Clinic which is following the patient
+1 NEW ORAMCL
+2 SET ORAMCL=$PIECE($GET(^ORAM(103,ORAMDFN,6)),U,2)
+3 SET RESULT=$SELECT(+ORAMCL>0:ORAMCL_";SC(",1:0)
+4 QUIT
+5 ;
GET(RESULT,ORAMENT,ORVDT) ; Get Parameters
+1 NEW ADD1,ADD2,ADD3,DNOTE,ENOTE,INOTE,ATEAM,CBCQO,CTEAM,CFAX,CPHONE,ORAMALL,IMPLDT,ICDCP
+2 NEW CENAB,CSVC,CPLXPH,IVST,LTR,ORIENT,SMPLPH,SVST,DSSID,DSSUNIT,HCT,HCTNM,NLABTM,TOLLFREE
+3 NEW INRQO,MCNM,NCLOC,PCEON,PHCLIN,POCNM,RPATH,SIGNM,SIGTTL,SITENM,VLOC,PILLSTR,ICDC,DPIND
+4 NEW SICDC,DSIND,ICDCS
+5 SET ORVDT=$GET(ORVDT,DT)
SET ICDCS="ICD-9-CM"
+6 SET IMPLDT=$$IMPDATE^LEXU("10D")
+7 SET ORAMENT=$SELECT($GET(ORAMENT)]"":$GET(ORAMENT),1:"ALL")
SET DPIND=""
+8 SET ORAMALL=$SELECT(ORAMENT["ALL":ORAMENT,1:"ALL^"_ORAMENT)
+9 SET ADD1=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 1",1,"I")
+10 SET ADD2=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 2",1,"I")
+11 SET ADD3=$$GET^XPAR(ORAMENT,"ORAM ADDRESS LINE 3",1,"I")
+12 SET DNOTE=$$GET^XPAR(ORAMALL,"ORAM DISCHARGE NOTE",1,"I")
+13 SET ENOTE=$$GET^XPAR(ORAMALL,"ORAM INTERIM NOTE",1,"I")
+14 SET INOTE=$$GET^XPAR(ORAMALL,"ORAM INITIAL NOTE",1,"I")
+15 SET ATEAM=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (ALL)",1,"I")
+16 SET CTEAM=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (COMPLEX)",1,"I")
+17 SET CBCQO=$$GET^XPAR(ORAMALL,"ORAM CBC QUICK ORDER",1,"I")
+18 SET CFAX=$$GET^XPAR(ORAMENT,"ORAM CLINIC FAX NUMBER",1,"I")
+19 SET CPHONE=$$GET^XPAR(ORAMENT,"ORAM CLINIC PHONE NUMBER",1,"I")
+20 SET TOLLFREE=$$GET^XPAR(ORAMENT,"ORAM TOLL FREE PHONE",1,"I")
+21 SET CENAB=$$GET^XPAR(ORAMENT,"ORAM CONSULT LINK ENABLED",1,"I")
+22 SET CSVC=$$GET^XPAR(ORAMENT,"ORAM CONSULT REQUEST SERVICE",1,"E")
+23 SET CPLXPH=$$GET^XPAR(ORAMALL,"ORAM CPT FOR COMPLEX PHONE",1,"I")
+24 SET IVST=$$GET^XPAR(ORAMALL,"ORAM CPT FOR INITIAL VISIT",1,"I")
+25 SET LTR=$$GET^XPAR(ORAMALL,"ORAM CPT FOR LETTER TO PT",1,"I")
+26 SET ORIENT=$$GET^XPAR(ORAMALL,"ORAM CPT FOR ORIENTATION",1,"I")
+27 SET SMPLPH=$$GET^XPAR(ORAMALL,"ORAM CPT FOR SIMPLE PHONE",1,"I")
+28 SET SVST=$$GET^XPAR(ORAMALL,"ORAM CPT FOR SUBSEQUENT VISIT",1,"I")
+29 SET DSSID=$$GET^XPAR(ORAMALL,"ORAM DSS ID",1,"I")
+30 SET DSSUNIT=$$GET^XPAR(ORAMALL,"ORAM DSS UNIT",1,"I")
+31 SET HCT=$$GET^XPAR(ORAMALL,"ORAM HCT/HGB REFERENCE",1,"B")
+32 SET HCTNM=$PIECE(HCT,U,2)
+33 SET HCT=$PIECE(HCT,U)
+34 SET INRQO=$$GET^XPAR(ORAMALL,"ORAM INR QUICK ORDER",1,"I")
+35 SET MCNM=$$GET^XPAR(ORAMALL,"ORAM MEDICAL CENTER NAME",1,"I")
+36 SET NCLOC=$$GET^XPAR(ORAMENT,"ORAM NON-COUNT LOCATION",1,"I")
+37 SET PCEON=$$GET^XPAR(ORAMENT,"ORAM PCE LINK ENABLED",1,"I")
+38 ; If I10 not yet implemented use I9 auto-prim indic, else use I10
+39 IF (IMPLDT>ORVDT)
Begin DoDot:1
+40 SET ICDC=$$GET^XPAR(ORAMENT,"ORAM AUTO PRIMARY INDICATION",1,"E")
SET ICDCS="ICD-9-CM"
End DoDot:1
IF 1
+41 IF '$TEST
Begin DoDot:1
+42 SET ICDC=$$GET^XPAR(ORAMENT,"ORAM I10 AUTO PRIM INDICATION",1,"E")
SET ICDCS="ICD-10-CM"
End DoDot:1
+43 IF ICDC]""
Begin DoDot:1
+44 NEW ICDDESC
+45 DO ICDDESC^ICDXCODE("DIAGNOSIS",ICDC,DT,.ICDDESC)
+46 SET DPIND=ICDC_U_$$TITLE^XLFSTR($GET(ICDDESC(1)))_" ("_ICDCS_" "_ICDC_")"
End DoDot:1
IF 1
+47 IF '$TEST
SET DPIND="^"
+48 ; If I10 not yet implemented use I9 auto-secondary indic, else use I10
+49 IF (IMPLDT>ORVDT)
Begin DoDot:1
+50 SET SICDC=$$GET^XPAR(ORAMENT,"ORAM AUTO SECONDARY INDICATION",1,"E")
SET ICDCS="ICD-9-CM"
End DoDot:1
IF 1
+51 IF '$TEST
Begin DoDot:1
+52 SET SICDC=$$GET^XPAR(ORAMENT,"ORAM I10 AUTO SEC INDICATION",1,"E")
SET ICDCS="ICD-10-CM"
End DoDot:1
+53 IF SICDC]""
Begin DoDot:1
+54 NEW ICDDESC
+55 DO ICDDESC^ICDXCODE("DIAGNOSIS",SICDC,DT,.ICDDESC)
+56 SET DSIND=SICDC_U_$$TITLE^XLFSTR($GET(ICDDESC(1)))_" ("_ICDCS_" "_SICDC_")"
End DoDot:1
IF 1
+57 IF '$TEST
SET DSIND="^"
+58 SET PHCLIN=$$GET^XPAR(ORAMENT,"ORAM PHONE CLINIC",1,"I")
+59 SET PILLSTR=$$GET^XPAR(ORAMENT,"ORAM DEFAULT PILL STRENGTH",1,"I")
+60 SET NLABTM=$$GET^XPAR(ORAMENT,"ORAM INCL TIME W/NEXT INR DATE",1,"I")
+61 SET POCNM=$$GET^XPAR(ORAMENT,"ORAM POINT OF CONTACT NAME",1,"I")
+62 SET RPATH=$$GET^XPAR(ORAMALL,"ORAM RAV FILE PATH",1,"I")
+63 SET SIGNM=$$GET^XPAR(ORAMENT,"ORAM SIGNATURE BLOCK NAME",1,"I")
+64 SET SIGTTL=$$GET^XPAR(ORAMENT,"ORAM SIGNATURE BLOCK TITLE",1,"I")
+65 SET SITENM=$$GET^XPAR(ORAMENT,"ORAM CLINIC NAME",1,"I")
+66 SET VLOC=$$GET^XPAR(ORAMENT,"ORAM VISIT LOCATION",1,"I")
+67 SET 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
+68 SET RESULT(1)=SIGNM_U_SIGTTL_U_POCNM_U_CPHONE_"|"_CFAX_U_MCNM_U_PILLSTR_U_NLABTM_U_TOLLFREE
+69 SET 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)
+70 SET RESULT(3)=DSIND
+71 QUIT
+72 ;
INDICS(RESULT,ORVDT) ; RPC To Get indications for care
+1 NEW IMPLDT
+2 SET ORVDT=$GET(ORVDT,DT)
+3 SET IMPLDT=$$IMPDATE^LEXU("10D")
+4 ; If I10 not yet implemented use I9 auto-prim indic, else use I10
+5 IF (IMPLDT>ORVDT)
Begin DoDot:1
+6 DO GETLST^XPAR(.RESULT,"SYS^PKG","ORAM INDICATIONS FOR CARE","E")
End DoDot:1
IF 1
+7 IF '$TEST
Begin DoDot:1
+8 DO GETLST^XPAR(.RESULT,"SYS^PKG","ORAM I10 INDICATIONS FOR CARE","E")
End DoDot:1
+9 IF +RESULT'>0
SET RESULT(0)=0
+10 QUIT
+11 ;
GETDIV() ; get division
+1 NEW DIV,ORAMY
+2 SET DIV=$$KSP^XUPARAM("INST")
SET ORAMY=0
+3 IF $$GET1^DIQ(4,DIV_",",5,"I")'="Y"
SET ORAMY=DIV_";DIC(4,"
IF 1
+4 IF '$TEST
SET ORAMY=$$SELDIV
+5 QUIT ORAMY
SELDIV() ; select division
+1 NEW DIC,X,Y
+2 WRITE !!,"Enter Anticoagulation Management Parameters by Division:",!
+3 SET DIC=4
SET DIC(0)="AEMQ"
SET DIC("S")="I +$O(^DG(40.8,""AD"",+Y,0))"
+4 DO ^DIC
if +Y>0
SET Y=+Y_";DIC(4,"
+5 QUIT Y
SELLOC() ; select hospital location
+1 NEW DIC,X,Y,TIUAPDT
SET DIC=44
SET DIC(0)="AEMQ"
+2 SET DIC("A")="Select CLINIC: "
+3 SET DIC("S")="I $$GOODLOC^ORAMSET(Y)"
+4 DO ^DIC
KILL DIC("S")
if +Y>0
SET Y=+Y_";SC("
+5 QUIT Y
GOODLOC(LOC) ; Returns 1 if ^SC hospital location IFN LOC is good, else 0
+1 NEW GOODLOC,INACTIVE,OOS,CLINIC,NONCOUNT
SET (GOODLOC,INACTIVE,NONCOUNT)=0
+2 IF +$GET(^SC(LOC,"I"))>0
IF (+$GET(^("I"))'>DT)
Begin DoDot:1
+3 SET INACTIVE=1
+4 ; check if reactivated:
+5 IF +$PIECE($GET(^("I")),U,2)>0
IF $PIECE($GET(^("I")),U,2)'>DT
SET INACTIVE=0
End DoDot:1
+6 ; Occasion of service
SET OOS=+$DATA(^SC(LOC,"OOS"))
+7 SET CLINIC=+($PIECE(^SC(LOC,0),U,3)="C")
+8 SET NONCOUNT=$SELECT($PIECE(^SC(LOC,0),U,17)="Y":1,1:0)
+9 IF 'INACTIVE
IF 'OOS
IF 'NONCOUNT
IF CLINIC
SET GOODLOC=1
+10 QUIT GOODLOC
GETPARM(X) ; Get parameter as IEN^NAME
+1 NEW DIC,Y
SET DIC=8989.51
SET DIC(0)="MQ"
+2 DO ^DIC
+3 QUIT Y
GETCMPDT(CODESYS) ; Returns compare date for indication set-up
+1 NEW Y,IDT
+2 SET CODESYS=$GET(CODESYS,"10D")
SET Y=DT
+3 SET IDT=$$IMPDATE^LEXU("10D")
+4 SET Y=$SELECT(CODESYS="10D":IDT,1:+$$FMADD^XLFDT(IDT,-1))
+5 QUIT Y
ISCODEOK(CODE,CODESYS) ; Boolean - is code active as of compare date for code system
+1 NEW Y,CDT,CODESTAT
+2 SET CODESYS=$GET(CODESYS,"10D")
SET Y=0
+3 SET CDT=$$GETCMPDT(CODESYS)
+4 SET CODESTAT=$$STATCHK^ICDEX(CODE,CDT,CODESYS)
+5 IF +CODESTAT=1
IF (+$PIECE(CODESTAT,U,3)>0)
IF ($PIECE(CODESTAT,U,3)'>CDT)
SET Y=1
+6 QUIT Y
