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

DBTSEYE.m

Go to the documentation of this file.
DBTSEYE ;BAO/DMH  pull patient EYE RETINOPATHY [ 11/16/1999  9:10 PM ]
 ;
 ;
 ;
START ;
 ;
EYE(DBTSGBL,DBTSP)          ;dbtsret is return value, dbtsp input value of patient ien
 ;
 ;
TEST ;
 K ^DBTSTEMP(1)
 S DBTSGBL="^DBTSTEMP("_1_")"
 S ARRAY=0
 ;S DBTSP=299
 ;
 D ^XBKVAR
 I DUZ(2)=4526 S DUZ(2)=2348
 S DBTS("LOC")=$P($G(^AUTTLOC(DUZ(2),0)),"^",10)
 I DBTS("LOC")="" S DBTSRET(1)="-1" S ^DBTSTEMP(1,1)="-1"_$C(13)_$C(10) Q
 S DBTS("FN")="9000010.07E"
 S DBTS("IEN")=0
 I '$D(^DBTSEXDI("B","DIABETIC EYE EXAM")) S ^DBTSTEMP(1,1)="-1"_$C(13)_$C(10) Q   ;may want to chg.
EX ;
 S DTCT=0   ;comment out when go with live data
 B  
 F I=1:1 S DBTS("IEN")=$O(^AUPNVPOV("AC",DBTSP,DBTS("IEN"))) Q:+DBTS("IEN")=0  D
 .S REC=$G(^AUPNVPOV(DBTS("IEN"),0))
 .Q:REC=""
 .S DBTS("POV")=$P(REC,"^",1)
 .S DBTS("ICD")=$P($G(^ICD9(DBTS("POV"),0)),"^",1)
 .Q:DBTS("ICD")=""
 .D EYECK Q:DBTS("CFL")="N"
 .S DBTS("STAGE")=$P(REC,"^",5)
 .D STAGE
 .S DBTS("ICDNAME")=$P($G(^ICD9(DBTS("POV"),0)),"^",3)
 .S DBTS("VDFN")=$P(REC,U,3)
 .Q:DBTS("VDFN")=""
 .S DBTS("VREC")=$G(^AUPNVSIT(DBTS("VDFN"),0))
 .Q:DBTS("VREC")=""
 .S DBTS("CL")=$P(DBTS("VREC"),U,8)
 .Q:+DBTS("CL")=0
 .S DBTS("CLCODE")=$P(^DIC(40.7,DBTS("CL"),0),U,2)
 .Q:DBTS("CLCODE")'=18
 .S DBTS("MODDT")=$P(DBTS("VREC"),U,13)
 .S DBTS("V")=$P(DBTS("VREC"),"^",1)
 .Q:DBTS("V")=""
 .S DBTS("V")=$P(DBTS("V"),".",1)
 .Q:DBTS("V")=""
 .S DBTS("DT")=DBTS("V")
 .D DTCHK^DBTSUT
 .Q:$D(DBTS("BADDT"))
 .S DBTS("VDATE")=$E(DBTS("V"),4,5)_"/"_$E(DBTS("V"),6,7)_"/"_($E(DBTS("V"),1,3)+1700)
 .S DBTS("PAT")=DBTSP
 .S DBTS("CN")=$P($G(^AUPNPAT(DBTSP,41,DUZ(2),0)),"^",2)
 .S DBTS("ID")=DBTS("LOC")_"|"_DBTS("FN")_"|"_DBTS("IEN")
 .S DBTS("VID")=DBTS("LOC")_"|9000010|"_DBTS("VDFN")  ;dmh 11-10-99
 .D MODCK
 .Q:DBTS("OK")="N"
 .D NARR
 .I '$D(DBTS("PNAR")) S DBTS("PNAR")=""
 .S ARRAY=ARRAY+1
 .S DBTSRET(ARRAY)=DBTS("ID")_U_DBTS("LOC")_U_DBTS("AU")_U_DBTS("PAT")_U_"EYE"_U_DBTS("ICD")_U_DBTS("ICDNAME")_U_DBTS("VDATE")_U_DBTS("STAGE")_U_DBTS("PNAR")_U_DBTS("VID")
 .S ^DBTSTEMP(1,ARRAY)=DBTSRET(ARRAY)_$C(13)_$C(10)
 .D LOG
 .Q
 I ARRAY=0 S DBTSRET(1)="-2" S ^DBTSTEMP(1,1)="-2"_$C(13)_$C(10)
 I $D(^DBTSPAT(DBTSP,"EYE")) S $P(^DBTSPAT(DBTSP,"EYE"),"^",2)=DT
 Q
EYECK ;
 S DBTS("CFL")="N"
 S DBTS("EYE")=$O(^DBTSEXDI("B","DIABETIC EYE EXAM",0))
 I $D(^DBTSEXDI(DBTS("EYE"),11,"B",DBTS("POV"))) S DBTS("CFL")="Y"
 Q
STAGE ;
 I DBTS("STAGE")="" Q
 I ((DBTS("POV")="250.50")!(DBTS("POV")="362.83")),DBTS("STAGE")'=7 S DBTS("STAGE")="" Q
 I (DBTS("POV")="362.01"),(DBTS("STAGE")>0),(DBTS("STAGE")<4) Q
 I DBTS("POV")="362.01" S DBTS("STAGE")="" Q
 I (DBTS("POV")="362.02"),(DBTS("STAGE")>3),(DBTS("STAGE")<7) Q
 I DBTS("POV")="362.02" S DBTS("STAGE")="" Q
 Q
MODCK ;
 S DBTS("OK")="Y"
 S DBTS("AU")="A"
 ;Q                            ;for testing
 Q:'$D(^DBTSPAT(DBTSP,"EYE"))
 ;I $P(^DBTSPAT(DBTSP,"EYE"),"^",2)="" Q   ;11-16-99
 S DBTS("MREC")=$G(^DBTSPAT(DBTSP,"EYE"))
 Q:DBTS("MREC")=""
 S DBTS("LDFN")=$P(DBTS("MREC"),U,1)
 I $P(^DBTSPAT(DBTSP,"EYE"),"^",2)="" Q   ;11-16-99
 Q:+DBTS("LDFN")<DBTS("IEN")
 S DBTS("LDT")=$P(DBTS("MREC"),U,2)
 I (+DBTS("LDT")>DBTS("MODDT")),(DBTS("LDFN")>DBTS("IEN")) S DBTS("OK")="N" Q
 I (DBTS("LDT")'>DBTS("MODDT")) S DBTS("AU")="U" Q
 S DBTS("OK")="N" Q
 Q
LOG ;  update the patient log for the type of lab test
 I '$D(DT) D ^XBKVAR 
 I '$D(^DBTSPAT(DBTSP)) D
 .K ^DBTSPAT("B",DBTSP)
 .S X=DBTSP,DINUM=X,DIC(0)="XNL",DIC="^DBTSPAT(" D FILE^DICN
 I '$D(^DBTSPAT(DBTSP,"EYE")) S ^DBTSPAT(DBTSP,"EYE")=DBTS("IEN")_"^" Q
 I $G(DBTS("LDFN"))<DBTS("IEN") S $P(^DBTSPAT(DBTSP,"EYE"),"^",1)=DBTS("IEN")
 Q
NARR ;  loop thru all povs for the visit dfn and pull the prov. narr.
 ;   3/24/99
 S DBTS("PNAR")=""
 S POV=0
 F  S POV=$O(^AUPNVPOV("AD",DBTS("VDFN"),POV)) Q:POV=""  D
 .I '$D(^AUPNVPOV(POV,0)) Q
 .S DBTS("PN")=$P(^AUPNVPOV(POV,0),U,4)
 .Q:+DBTS("PN")=0
 .Q:'$D(^AUTNPOV(DBTS("PN"),0))
 .S NARR=$P(^AUTNPOV(DBTS("PN"),0),U,1)
 .I NARR'="" D NARR^DBTSUT
 .I DBTS("PNAR")="" S DBTS("PNAR")=NARR
 .E  S DBTS("PNAR")=DBTS("PNAR")_"  "_NARR
 .Q
 ;S NARR=DBTS("PNAR") D NARR2^DBTSUT S DBTS("PNAR")=NARR
 Q