BMXADOV2 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
;;4.0;BMX;;JUN 28, 2010
; CUSTOM ITERATORS FOR RPMS
;
;
;
MEDICARE(PARAM,IENS,MAX,OUT,TOT) ;
; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
; FETCHES THE MOST RECENT MEDICARE RECORD FOR THE PATIENT
N DFN,DA,X,Y,%,LIM,DATE,MAX
S LIM=DT-10000,DA=0,DATE=0,MAX=0
S DFN=$P(IENS,C,2) I 'DFN Q ""
F S DA=$O(^AUPNMCR(DFN,11,DA)) Q:'DA D
. S X=$G(^AUPNMCR(DFN,11,DA,0))
. I +X>DATE S DATE=+X,MAX=DA
. Q
I 'MAX Q ""
S DA=MAX
D DATA^BMXADOV1(IENS,DA)
Q ""
;
MCDIEN(DFN) ; EP-GIVEN A PATIENT IEN, RETRUN THE IEN OF THAT PT'S MOST RECENT RECORD IN MEDICAID ELIGIBILITY FILE
N MIEN,DA,DATE,MAX,X
S DFN=+$G(DFN),MAX="",DATE=0
S MIEN=0 F S MIEN=$O(^AUPNMCD("B",DFN,MIEN)) Q:'MIEN D
. S DA=0 F S DA=$O(^AUPNMCD(MIEN,11,DA)) Q:'DA D
.. S X=+$P($G(^AUPNMCD(MIEN,11,DA,0)),U,2)
.. I X>DATE S DATE=X,MAX=MIEN
.. Q
. Q
Q MAX
;
MEDICAID(PARAM,IENS,MAX,OUT,TOT) ;
; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
; FETCHES THE MOST RECENT MEDICARE RECORD FOR THE PATIENT
N MIEN,DA,X,Y,%,LIM,DATE,MAX
S LIM=DT-10000,DA=0,DATE=0,MAX=0
S MIEN=$P(IENS,C,2) I 'MIEN Q ""
F S DA=$O(^AUPNMCD(MIEN,11,DA)) Q:'DA D
. S X=$G(^AUPNMCD(MIEN,11,DA,0))
. I +X>DATE S DATE=+X,MAX=DA
. Q
I 'MAX Q ""
S DA=MAX
D DATA^BMXADOV1(IENS,DA)
Q ""
;
PT(VAL,IENS,MAX,OUT,TOT) ; EP - PATIENT LOOKUP ; GIVEN A LOOKUP VALUE, GENERATE A LIST OF PATIENTS
N DFN,BMXNOID,DA,X,Y,%,LIM,FILE,NUM,IXS,GBL,CNT,SS
I $G(VAL)="" Q ""
S BMXNOID=1
I '$G(MAX) S MAX=999
I $G(^DD("2","0","ID","IHS0"))="D ^AUPNLKID" S ^("IHS0")="D:'$G(BMXNOID) ^AUPNLKID" ; MUST BE A SILENT CALL
S SS="BMX DFN2",GBL=$NA(^TMP(SS,$J)) K @GBL
S CNT=0,DFN=0
F S DFN=$O(^AUPNPAT("D",VAL,DFN)) Q:'DFN S CNT=CNT+1 S @GBL@("DILIST",2,CNT)=DFN ; FIRST, TRY TO MATCH CHART NUMBER
I CNT G PTIT
I VAL?3N1"-"2N1"-"4N S VAL=$TR(VAL,"-","") ; TRANSFORM SSN
I VAL?9N G PT1
S %=$L(VAL),X=$E(VAL,%-1,%)
I X?2N S X=VAL,%DT="P" D ^%DT S VAL=Y ; TRANSFORM DATE TO INTERNAL VALUE
PT1 K @GBL S SS="BMX DFN1",GBL=$NA(^TMP(SS,$J)) K @GBL
D FIND^DIC(2,"","","",VAL,999,"B^ADOB^SSN","","",GBL,"")
I '$D(^TMP(SS,$J,"DILIST",2)) Q "" ; UNSUCCESSFUL LOOKUP
PTIT ; ITERATE
S CNT=0,NUM=0
F S CNT=$O(^TMP(SS,$J,"DILIST",2,CNT)) Q:'CNT S DA=^(CNT) I DA D DATA^BMXADOV1(IENS,DA)
I $G(^DD("2","0","ID","IHS0"))="D:'$G(BMXNOID) ^AUPNLKID" S ^("IHS0")="D ^AUPNLKID" ; RESTORE DD NODE
; K @GBL ; CLEANUP
Q ""
;
HRN(DFN) ; EP - GIVEN A PATIENT DFN, RETURN THE LOCAL CHART NUMBER
Q $P($G(^AUPNPAT(+$G(DFN),41,+$G(DUZ(2)),0)),U,2)
;
PVTINS ;
; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
N DFN,DA,X,Y,%,LIM
S LIM=DT-10000,DA=0
S DFN=$P(IENS,C,2) I 'DFN Q ""
F S DA=$O(^AUPNPRVT(DFN,11,DA)) Q:'DA D
. S X=$G(^AUPNPRVT(DFN,11,DA,0))
. I '$L(X) Q
. S %=$P(X,U,7)
. I '%!(%>LIM) D DATA^BMXADOV1(IENS,DA)
. Q
Q ""
;
DUPV(PARAM,IENS,MAX,OUT,TOT) ; EP - DUPLICATE VISIT ITERATION
; PARAM: 'DFN|VISIT TIMESTAMP|TYPE|LOCATION|CATEGORY
; PATIENT DFN AND VISIT TIMESTAMP (EXTERNAL DATE FORMAT) MUST EXIST.
; THE OTHER 3 DUP PARAMETERS WILL BE CHECKED ONLY IF THEY ARE DEFINED.
; ALL DUPS ARE RETURNED. MAX,START,STOP ARE IGNORED
N DFN,TIME,TYPE,LOC,CAT,IDT,VIEN,DAY,X,PATIENT,Y,%DT,FMTIME,DA,IENS
S DFN=+PARAM,TIME=$P(PARAM,B,2),TYPE=$P(PARAM,B,3),LOC=$P(PARAM,B,4),CAT=$P(PARAM,B,5)
I $D(^DPT(+$G(DFN),0)),$L($G(TIME))
E Q ""
S X=TIME,%DT="T" D ^%DT I Y=-1 Q
S FMTIME=Y
S (IDT,DAY)=9999999-(FMTIME\1),IDT=IDT-.0000001
F S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:$E(IDT,1,7)'=DAY S VIEN=999999999999 F S VIEN=$O(^AUPNVSIT("AA",DFN,IDT,VIEN),-1) Q:'VIEN D
. S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q ; VISIT DATA MUST EXIT
. I $P(X,U,11) Q ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED'
. I $L(TYPE),TYPE'=$P(X,U,3) Q
. I $L(LOC),LOC'=$P(X,U,6) Q
. I $L(CAT),CAT'=$P(X,U,7) Q
. S DA=VIEN,IENS=DA_C
. D DATA^BMXADOV1(IENS,DA)
. Q
Q ""
;
DAIT(DSTG,IENS,MAX,OUT,TOT) ; EP - SET OF IENS ITERATION.
; THE DSTG CONTAINS A "|" SET OF DAS STRINGS
; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT
N PCE,DA,XIT,IENS,L,DAS
S L=$L(DSTG,B)
F PCE=1:1:L S DAS=$P(DSTG,B,PCE) D I $G(XIT) Q
. I 'DAS S XIT=1 Q ; NO MORE IENS - THE END OF THE LINE
. I DAS'[C S IENS=DAS_C
. E S IENS=$$IENS^BMXADOV(DAS)
. S DA=+IENS
. D DATA^BMXADOV1(IENS,DA)
. Q
Q ""
;
APRV(PARAM,IENS,MAX,OUT,TOT) ; EP - RETURN A LIST OF ALL ACTIVE PROVIDERS
; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT
N NAME,DA,STG
S NAME=""
F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" D
. S DA=0
. F S DA=$O(^VA(200,"B",NAME,DA)) Q:'DA D
.. I $P($G(^VA(200,DA,"PS")),U,4) Q ; CHECK INACTIVE DATE FIELD
.. D DATA^BMXADOV1(IENS,DA)
.. Q
. Q
Q ""
;
BMXADOV2 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ; CUSTOM ITERATORS FOR RPMS
+3 ;
+4 ;
+5 ;
MEDICARE(PARAM,IENS,MAX,OUT,TOT) ;
+1 ; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
+2 ; FETCHES THE MOST RECENT MEDICARE RECORD FOR THE PATIENT
+3 NEW DFN,DA,X,Y,%,LIM,DATE,MAX
+4 SET LIM=DT-10000
SET DA=0
SET DATE=0
SET MAX=0
+5 SET DFN=$PIECE(IENS,C,2)
IF 'DFN
QUIT ""
+6 FOR
SET DA=$ORDER(^AUPNMCR(DFN,11,DA))
IF 'DA
QUIT
Begin DoDot:1
+7 SET X=$GET(^AUPNMCR(DFN,11,DA,0))
+8 IF +X>DATE
SET DATE=+X
SET MAX=DA
+9 QUIT
End DoDot:1
+10 IF 'MAX
QUIT ""
+11 SET DA=MAX
+12 DO DATA^BMXADOV1(IENS,DA)
+13 QUIT ""
+14 ;
MCDIEN(DFN) ; EP-GIVEN A PATIENT IEN, RETRUN THE IEN OF THAT PT'S MOST RECENT RECORD IN MEDICAID ELIGIBILITY FILE
+1 NEW MIEN,DA,DATE,MAX,X
+2 SET DFN=+$GET(DFN)
SET MAX=""
SET DATE=0
+3 SET MIEN=0
FOR
SET MIEN=$ORDER(^AUPNMCD("B",DFN,MIEN))
IF 'MIEN
QUIT
Begin DoDot:1
+4 SET DA=0
FOR
SET DA=$ORDER(^AUPNMCD(MIEN,11,DA))
IF 'DA
QUIT
Begin DoDot:2
+5 SET X=+$PIECE($GET(^AUPNMCD(MIEN,11,DA,0)),U,2)
+6 IF X>DATE
SET DATE=X
SET MAX=MIEN
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT MAX
+10 ;
MEDICAID(PARAM,IENS,MAX,OUT,TOT) ;
+1 ; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
+2 ; FETCHES THE MOST RECENT MEDICARE RECORD FOR THE PATIENT
+3 NEW MIEN,DA,X,Y,%,LIM,DATE,MAX
+4 SET LIM=DT-10000
SET DA=0
SET DATE=0
SET MAX=0
+5 SET MIEN=$PIECE(IENS,C,2)
IF 'MIEN
QUIT ""
+6 FOR
SET DA=$ORDER(^AUPNMCD(MIEN,11,DA))
IF 'DA
QUIT
Begin DoDot:1
+7 SET X=$GET(^AUPNMCD(MIEN,11,DA,0))
+8 IF +X>DATE
SET DATE=+X
SET MAX=DA
+9 QUIT
End DoDot:1
+10 IF 'MAX
QUIT ""
+11 SET DA=MAX
+12 DO DATA^BMXADOV1(IENS,DA)
+13 QUIT ""
+14 ;
PT(VAL,IENS,MAX,OUT,TOT) ; EP - PATIENT LOOKUP ; GIVEN A LOOKUP VALUE, GENERATE A LIST OF PATIENTS
+1 NEW DFN,BMXNOID,DA,X,Y,%,LIM,FILE,NUM,IXS,GBL,CNT,SS
+2 IF $GET(VAL)=""
QUIT ""
+3 SET BMXNOID=1
+4 IF '$GET(MAX)
SET MAX=999
+5 ; MUST BE A SILENT CALL
IF $GET(^DD("2","0","ID","IHS0"))="D ^AUPNLKID"
SET ^("IHS0")="D:'$G(BMXNOID) ^AUPNLKID"
+6 SET SS="BMX DFN2"
SET GBL=$NAME(^TMP(SS,$JOB))
KILL @GBL
+7 SET CNT=0
SET DFN=0
+8 ; FIRST, TRY TO MATCH CHART NUMBER
FOR
SET DFN=$ORDER(^AUPNPAT("D",VAL,DFN))
IF 'DFN
QUIT
SET CNT=CNT+1
SET @GBL@("DILIST",2,CNT)=DFN
+9 IF CNT
GOTO PTIT
+10 ; TRANSFORM SSN
IF VAL?3N1"-"2N1"-"4N
SET VAL=$TRANSLATE(VAL,"-","")
+11 IF VAL?9N
GOTO PT1
+12 SET %=$LENGTH(VAL)
SET X=$EXTRACT(VAL,%-1,%)
+13 ; TRANSFORM DATE TO INTERNAL VALUE
IF X?2N
SET X=VAL
SET %DT="P"
DO ^%DT
SET VAL=Y
PT1 KILL @GBL
SET SS="BMX DFN1"
SET GBL=$NAME(^TMP(SS,$JOB))
KILL @GBL
+1 DO FIND^DIC(2,"","","",VAL,999,"B^ADOB^SSN","","",GBL,"")
+2 ; UNSUCCESSFUL LOOKUP
IF '$DATA(^TMP(SS,$JOB,"DILIST",2))
QUIT ""
PTIT ; ITERATE
+1 SET CNT=0
SET NUM=0
+2 FOR
SET CNT=$ORDER(^TMP(SS,$JOB,"DILIST",2,CNT))
IF 'CNT
QUIT
SET DA=^(CNT)
IF DA
DO DATA^BMXADOV1(IENS,DA)
+3 ; RESTORE DD NODE
IF $GET(^DD("2","0","ID","IHS0"))="D:'$G(BMXNOID) ^AUPNLKID"
SET ^("IHS0")="D ^AUPNLKID"
+4 ; K @GBL ; CLEANUP
+5 QUIT ""
+6 ;
HRN(DFN) ; EP - GIVEN A PATIENT DFN, RETURN THE LOCAL CHART NUMBER
+1 QUIT $PIECE($GET(^AUPNPAT(+$GET(DFN),41,+$GET(DUZ(2)),0)),U,2)
+2 ;
PVTINS ;
+1 ; NO PARAM REQUIRED BUT SINCE THIS IS A SUBFILE, THE PATIENT IEN MUST BE IH IENS
+2 NEW DFN,DA,X,Y,%,LIM
+3 SET LIM=DT-10000
SET DA=0
+4 SET DFN=$PIECE(IENS,C,2)
IF 'DFN
QUIT ""
+5 FOR
SET DA=$ORDER(^AUPNPRVT(DFN,11,DA))
IF 'DA
QUIT
Begin DoDot:1
+6 SET X=$GET(^AUPNPRVT(DFN,11,DA,0))
+7 IF '$LENGTH(X)
QUIT
+8 SET %=$PIECE(X,U,7)
+9 IF '%!(%>LIM)
DO DATA^BMXADOV1(IENS,DA)
+10 QUIT
End DoDot:1
+11 QUIT ""
+12 ;
DUPV(PARAM,IENS,MAX,OUT,TOT) ; EP - DUPLICATE VISIT ITERATION
+1 ; PARAM: 'DFN|VISIT TIMESTAMP|TYPE|LOCATION|CATEGORY
+2 ; PATIENT DFN AND VISIT TIMESTAMP (EXTERNAL DATE FORMAT) MUST EXIST.
+3 ; THE OTHER 3 DUP PARAMETERS WILL BE CHECKED ONLY IF THEY ARE DEFINED.
+4 ; ALL DUPS ARE RETURNED. MAX,START,STOP ARE IGNORED
+5 NEW DFN,TIME,TYPE,LOC,CAT,IDT,VIEN,DAY,X,PATIENT,Y,%DT,FMTIME,DA,IENS
+6 SET DFN=+PARAM
SET TIME=$PIECE(PARAM,B,2)
SET TYPE=$PIECE(PARAM,B,3)
SET LOC=$PIECE(PARAM,B,4)
SET CAT=$PIECE(PARAM,B,5)
+7 IF $DATA(^DPT(+$GET(DFN),0))
IF $LENGTH($GET(TIME))
+8 IF '$TEST
QUIT ""
+9 SET X=TIME
SET %DT="T"
DO ^%DT
IF Y=-1
QUIT
+10 SET FMTIME=Y
+11 SET (IDT,DAY)=9999999-(FMTIME\1)
SET IDT=IDT-.0000001
+12 FOR
SET IDT=$ORDER(^AUPNVSIT("AA",DFN,IDT))
IF $EXTRACT(IDT,1,7)'=DAY
QUIT
SET VIEN=999999999999
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,IDT,VIEN),-1)
IF 'VIEN
QUIT
Begin DoDot:1
+13 ; VISIT DATA MUST EXIT
SET X=$GET(^AUPNVSIT(VIEN,0))
IF '$LENGTH(X)
QUIT
+14 ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED'
IF $PIECE(X,U,11)
QUIT
+15 IF $LENGTH(TYPE)
IF TYPE'=$PIECE(X,U,3)
QUIT
+16 IF $LENGTH(LOC)
IF LOC'=$PIECE(X,U,6)
QUIT
+17 IF $LENGTH(CAT)
IF CAT'=$PIECE(X,U,7)
QUIT
+18 SET DA=VIEN
SET IENS=DA_C
+19 DO DATA^BMXADOV1(IENS,DA)
+20 QUIT
End DoDot:1
+21 QUIT ""
+22 ;
DAIT(DSTG,IENS,MAX,OUT,TOT) ; EP - SET OF IENS ITERATION.
+1 ; THE DSTG CONTAINS A "|" SET OF DAS STRINGS
+2 ; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT
+3 NEW PCE,DA,XIT,IENS,L,DAS
+4 SET L=$LENGTH(DSTG,B)
+5 FOR PCE=1:1:L
SET DAS=$PIECE(DSTG,B,PCE)
Begin DoDot:1
+6 ; NO MORE IENS - THE END OF THE LINE
IF 'DAS
SET XIT=1
QUIT
+7 IF DAS'[C
SET IENS=DAS_C
+8 IF '$TEST
SET IENS=$$IENS^BMXADOV(DAS)
+9 SET DA=+IENS
+10 DO DATA^BMXADOV1(IENS,DA)
+11 QUIT
End DoDot:1
IF $GET(XIT)
QUIT
+12 QUIT ""
+13 ;
APRV(PARAM,IENS,MAX,OUT,TOT) ; EP - RETURN A LIST OF ALL ACTIVE PROVIDERS
+1 ; ALL VALUES ARE RETURNED. MAX IS NOT CHECKED. START AND STOP ARE IRRELEVANT
+2 NEW NAME,DA,STG
+3 SET NAME=""
+4 FOR
SET NAME=$ORDER(^VA(200,"B",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+5 SET DA=0
+6 FOR
SET DA=$ORDER(^VA(200,"B",NAME,DA))
IF 'DA
QUIT
Begin DoDot:2
+7 ; CHECK INACTIVE DATE FIELD
IF $PIECE($GET(^VA(200,DA,"PS")),U,4)
QUIT
+8 DO DATA^BMXADOV1(IENS,DA)
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT ""
+12 ;
