- 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 Jan 18, 2025@03:28:18 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