AGBIC1A.m

AGBIC1A ; IHS/ASDS/EFG - BUILD FILE OF PT DEMOGRAPHIC DATA TO BE BIC'D ; 

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 S AGTMP="^AGBICP" K @AGTMP S ^AGBICP(0)="BIC PRINT^9009061.1^0^0",AGDFN1=0

BICLOOP S AGDFN1=$O(^AGBICH(AGDFN1)) G:AGDFN1'=+AGDFN1 END

 S AGDFN2=$P(^AGBICH(AGDFN1,0),U),DR="1126///"_"Y",DA=AGDFN2,DIE="^AUPNPAT(" D ^DIE

 D EXPIRE I $P(^DPT(AGDFN2,0),U)="" G BICLOOP

 S DIC("DR")=".02////"_DT

 I $P(^DPT(AGDFN2,0),U,9)]"" S DIC("DR")=DIC("DR")_";.03////"_$P(^DPT(AGDFN2,0),U,9) ; SSN

 I $P(^DPT(AGDFN2,0),U,3)]"" S DIC("DR")=DIC("DR")_";.04////"_$P(^DPT(AGDFN2,0),U,3) ; DOB

 I $P(^DPT(AGDFN2,0),U,2)]"" S DIC("DR")=DIC("DR")_";.05////"_$P(^DPT(AGDFN2,0),U,2) ; SEX

 I $D(^AUPNPAT(AGDFN2,11)),$P(^AUPNPAT(AGDFN2,11),U,8)]"" S DIC("DR")=DIC("DR")_";.06////"_$P(^AUTTTRI($P(^AUPNPAT(AGDFN2,11),U,8),0),U,2) ; TRIBE

 I AGXPIRE]"" S DIC("DR")=DIC("DR")_";.08////"_AGXPIRE

 I $P(^AGBICH(AGDFN1,0),U,2)]"" S DIC("DR")=DIC("DR")_";.09////"_$P(^DIC(4,$P(^AGBICH(AGDFN1,0),U,2),0),U) ; ISSUING FACILITY

 I $P(^AUTTLOC($P(^AGBICH(AGDFN1,0),U,2),0),U,11)]"" S DIC("DR")=DIC("DR")_";.11////"_$P(^AUTTLOC($P(^AGBICH(AGDFN1,0),U,2),0),U,11) ; PHONE

 S DIC="^AGBICP(",DIC(0)="L",X=$P(^DPT(AGDFN2,0),U)

 K DD,DO D FILE^DICN

 G BICLOOP

END K AG,AGDFN1,AGDFN2,AGXPIRE

 Q

EXPIRE S AGXPIRE="" Q:$P(^DPT(AGDFN2,0),U,3)=""

 S DA=AGDFN2,DIC=9000001,DR=1102.99 D ^AGDICLK Q:AG("LKPRINT")'<18

 Q:$P(^AUPNPAT(AGDFN2,11),U,25)'="Y"

 S AGXPIRE=$P(^DPT(AGDFN2,0),U,3)+180000

 Q

AGBIC1A   ; IHS/ASDS/EFG - BUILD FILE OF PT DEMOGRAPHIC DATA TO BE BIC'D ; 

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2        SET AGTMP="^AGBICP"

           KILL @AGTMP

           SET ^AGBICP(0)="BIC PRINT^9009061.1^0^0"

           SET AGDFN1=0

BICLOOP    SET AGDFN1=$ORDER(^AGBICH(AGDFN1))

           IF AGDFN1'=+AGDFN1

               GOTO END

 +1        SET AGDFN2=$PIECE(^AGBICH(AGDFN1,0),U)

           SET DR="1126///"_"Y"

           SET DA=AGDFN2

           SET DIE="^AUPNPAT("

           DO ^DIE

 +2        DO EXPIRE

           IF $PIECE(^DPT(AGDFN2,0),U)=""

               GOTO BICLOOP

 +3        SET DIC("DR")=".02////"_DT

 +4       ; SSN

           IF $PIECE(^DPT(AGDFN2,0),U,9)]""

               SET DIC("DR")=DIC("DR")_";.03////"_$PIECE(^DPT(AGDFN2,0),U,9)

 +5       ; DOB

           IF $PIECE(^DPT(AGDFN2,0),U,3)]""

               SET DIC("DR")=DIC("DR")_";.04////"_$PIECE(^DPT(AGDFN2,0),U,3)

 +6       ; SEX

           IF $PIECE(^DPT(AGDFN2,0),U,2)]""

               SET DIC("DR")=DIC("DR")_";.05////"_$PIECE(^DPT(AGDFN2,0),U,2)

 +7       ; TRIBE

           IF $DATA(^AUPNPAT(AGDFN2,11))

               IF $PIECE(^AUPNPAT(AGDFN2,11),U,8)]""

                   SET DIC("DR")=DIC("DR")_";.06////"_$PIECE(^AUTTTRI($PIECE(^AUPNPAT(AGDFN2,11),U,8),0),U,2)

 +8        IF AGXPIRE]""

               SET DIC("DR")=DIC("DR")_";.08////"_AGXPIRE

 +9       ; ISSUING FACILITY

           IF $PIECE(^AGBICH(AGDFN1,0),U,2)]""

               SET DIC("DR")=DIC("DR")_";.09////"_$PIECE(^DIC(4,$PIECE(^AGBICH(AGDFN1,0),U,2),0),U)

 +10      ; PHONE

           IF $PIECE(^AUTTLOC($PIECE(^AGBICH(AGDFN1,0),U,2),0),U,11)]""

               SET DIC("DR")=DIC("DR")_";.11////"_$PIECE(^AUTTLOC($PIECE(^AGBICH(AGDFN1,0),U,2),0),U,11)

 +11       SET DIC="^AGBICP("

           SET DIC(0)="L"

           SET X=$PIECE(^DPT(AGDFN2,0),U)

 +12       KILL DD,DO

           DO FILE^DICN

 +13       GOTO BICLOOP

END        KILL AG,AGDFN1,AGDFN2,AGXPIRE

 +1        QUIT 

EXPIRE     SET AGXPIRE=""

           IF $PIECE(^DPT(AGDFN2,0),U,3)=""

               QUIT 

 +1        SET DA=AGDFN2

           SET DIC=9000001

           SET DR=1102.99

           DO ^AGDICLK

           IF AG("LKPRINT")'<18

               QUIT 

 +2        IF $PIECE(^AUPNPAT(AGDFN2,11),U,25)'="Y"

               QUIT 

 +3        SET AGXPIRE=$PIECE(^DPT(AGDFN2,0),U,3)+180000

 +4        QUIT