source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/routines/BMXADOV2.m@ 1172

BMXADOV2        ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
        ;;4.1000;BMX;;Apr 17, 2011
        ; 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 ""
        ;