AZAMED1.m

AZAMED1 ; IHS/PHXAO/TMJ - MEDICAID TAPE TO ELIG FILE ; [ 06/12/03  2:38 PM ]

 ;

 N IFN,DFN,IEN,EED,EBD,CT,NUM,SEX,N,NAME S STOP=""

A ; -- loop medicaid tape data

 S IFN=0 F  S IFN=$O(^AZAGMED(IFN)) Q:'IFN  Q:STOP=10  D

 . S N=^AZAGMED(IFN),SSN=$E(N,27,35) Q:'SSN

 . S DFN=$O(^DPT("SSN",SSN,0)) Q:'DFN  

 . S NAME=$P(^DPT(DFN,0),U),SEX=$P(^(0),U,2)

 . S NUM=$E(N,18,26),EED=$$EED,EBD=$$EBD,CT=$E(N,91,92)

 . Q:EED<$$EHIS  

 . I '$O(^AUPNMCD("B",DFN,0)) W !,NAME S STOP=STOP+1

 Q

 ;

MED ; -- add eligiblity date(s)/data

 S IEN=$O(^AUPNMCD("B",DFN,0)) D:'IEN NEW Q:'IEN

 S:'$D(^AUPNMCD(IEN,11,0)) $P(^(0),U,2)="9000004.11D"

 Q:$D(^AUPNMCD(IEN,11,EBD))

 S DIE="^AUPNMCD("_IEN_",11,",DA(1)=IEN,DA=EBD

 S DR=".01////"_EBD_";.02////"_EED_";.03////"_CT D ^DIE K DIE,DR,DA

 Q

 ;

NEW ; -- create new entry in medicaid eligible

 N X,Y S X=DFN,DIC="^AUPNMCD(",DIC(0)="L"

 S DIC("DR")=".02////3;.03////"_NUM_";.04////2;.05////"_NAME

 S DIC("DR")=DIC("DR")_";.07////"_SEX

 D FILE^DICN S IEN=+Y K DIC

ENEW Q

 ;

EED() ; -- eligibility end date

 N X,Y S X=$E(N,412,419) D ^%DT Q Y

 ;

EBD() ; -- eligibility beg date

 N X,Y S X=$E(N,347,354) D ^%DT Q Y

 ;

EHIS() ; -- eligibility history flag

 N X1,X2,X S X1=DT,X2=-180 D C^%DTC Q X

AZAMED1   ; IHS/PHXAO/TMJ - MEDICAID TAPE TO ELIG FILE ; [ 06/12/03  2:38 PM ]

 +1       ;

 +2        NEW IFN,DFN,IEN,EED,EBD,CT,NUM,SEX,N,NAME

           SET STOP=""

A         ; -- loop medicaid tape data

 +1        SET IFN=0

           FOR 

               SET IFN=$ORDER(^AZAGMED(IFN))

               IF 'IFN

                   QUIT 

               IF STOP=10

                   QUIT 

               Begin DoDot:1

 +2                SET N=^AZAGMED(IFN)

                   SET SSN=$EXTRACT(N,27,35)

                   IF 'SSN

                       QUIT 

 +3                SET DFN=$ORDER(^DPT("SSN",SSN,0))

                   IF 'DFN

                       QUIT 

 +4                SET NAME=$PIECE(^DPT(DFN,0),U)

                   SET SEX=$PIECE(^(0),U,2)

 +5                SET NUM=$EXTRACT(N,18,26)

                   SET EED=$$EED

                   SET EBD=$$EBD

                   SET CT=$EXTRACT(N,91,92)

 +6                IF EED<$$EHIS

                       QUIT 

 +7                IF '$ORDER(^AUPNMCD("B",DFN,0))

                       WRITE !,NAME

                       SET STOP=STOP+1

               End DoDot:1

 +8        QUIT 

 +9       ;

MED       ; -- add eligiblity date(s)/data

 +1        SET IEN=$ORDER(^AUPNMCD("B",DFN,0))

           IF 'IEN

               DO NEW

           IF 'IEN

               QUIT 

 +2        IF '$DATA(^AUPNMCD(IEN,11,0))

               SET $PIECE(^(0),U,2)="9000004.11D"

 +3        IF $DATA(^AUPNMCD(IEN,11,EBD))

               QUIT 

 +4        SET DIE="^AUPNMCD("_IEN_",11,"

           SET DA(1)=IEN

           SET DA=EBD

 +5        SET DR=".01////"_EBD_";.02////"_EED_";.03////"_CT

           DO ^DIE

           KILL DIE,DR,DA

 +6        QUIT 

 +7       ;

NEW       ; -- create new entry in medicaid eligible

 +1        NEW X,Y

           SET X=DFN

           SET DIC="^AUPNMCD("

           SET DIC(0)="L"

 +2        SET DIC("DR")=".02////3;.03////"_NUM_";.04////2;.05////"_NAME

 +3        SET DIC("DR")=DIC("DR")_";.07////"_SEX

 +4        DO FILE^DICN

           SET IEN=+Y

           KILL DIC

ENEW       QUIT 

 +1       ;

EED()     ; -- eligibility end date

 +1        NEW X,Y

           SET X=$EXTRACT(N,412,419)

           DO ^%DT

           QUIT Y

 +2       ;

EBD()     ; -- eligibility beg date

 +1        NEW X,Y

           SET X=$EXTRACT(N,347,354)

           DO ^%DT

           QUIT Y

 +2       ;

EHIS()    ; -- eligibility history flag

 +1        NEW X1,X2,X

           SET X1=DT

           SET X2=-180

           DO C^%DTC

           QUIT X