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

BMXADOV2.m

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