APCLDF4.m

APCLDF4 ; IHS/CMI/LAB - PROCESS DEMOGRAPHIC INFORMATION ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

D ; -ENTRY POINT FROM APCLDF - Demographic

 K APCL("DEM")

 S VAL=$P(X," ",2,10)

 I VAL="" S APCLER=15 G X7

 F FILE=2,9000001 Q:$D(APCL("DEM"))  I $D(^DD(FILE,"B",VAL)) S (FLD,DR)=$O(^(VAL,"")),(FN,DIC)=FILE,DA=PAT,DIQ="APCL(""DEM"",",DIQ(0)="E" D EN^DIQ1

 I '$D(APCL("DEM")) F FILE=2,9000001 Q:$D(APCL("DEM"))!$D(APCLER)  I $O(^DD(FILE,"B",VAL))]"",$E($O(^(VAL)),1,$L(VAL))=VAL D  G:$D(APCLER) X7 S (FLD,DR)=$O(^DD(FILE,"B",TVAL,"")),(FN,DIC)=FILE,DA=PAT,DIQ="APCL(""DEM"",",DIQ(0)="E" D EN^DIQ1

 . S TVAL=$O(^DD(FILE,"B",VAL))

 . I $O(^DD(FILE,"B",TVAL))]"" S TVAL2=$O(^(TVAL)) I $E(TVAL2,1,$L(VAL))=VAL S APCLER=13 G X6

X6 . Q

 I $D(APCL("DEM")) S @(APCLY_1_")")=$S($D(DT):DT,1:"")_U_APCL("DEM",FN,$O(APCL("DEM",FN,"")),FLD,"E") K:$P(@(APCLY_1_")"),U,2)="" @(APCLY_1_")")

 E  S APCLER=4

 K APCL,DIC,DA,DR,DIQ

X7 Q

 ;

APCLDF4   ; IHS/CMI/LAB - PROCESS DEMOGRAPHIC INFORMATION ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

D         ; -ENTRY POINT FROM APCLDF - Demographic

 +1        KILL APCL("DEM")

 +2        SET VAL=$PIECE(X," ",2,10)

 +3        IF VAL=""

               SET APCLER=15

               GOTO X7

 +4        FOR FILE=2,9000001

               IF $DATA(APCL("DEM"))

                   QUIT 

               IF $DATA(^DD(FILE,"B",VAL))

                   SET (FLD,DR)=$ORDER(^(VAL,""))

                   SET (FN,DIC)=FILE

                   SET DA=PAT

                   SET DIQ="APCL(""DEM"","

                   SET DIQ(0)="E"

                   DO EN^DIQ1

 +5        IF '$DATA(APCL("DEM"))

               FOR FILE=2,9000001

                   IF $DATA(APCL("DEM"))!$DATA(APCLER)

                       QUIT 

                   IF $ORDER(^DD(FILE,"B",VAL))]""

                       IF $EXTRACT($ORDER(^(VAL)),1,$LENGTH(VAL))=VAL

                           Begin DoDot:1

 +6                            SET TVAL=$ORDER(^DD(FILE,"B",VAL))

 +7                            IF $ORDER(^DD(FILE,"B",TVAL))]""

                                   SET TVAL2=$ORDER(^(TVAL))

                                   IF $EXTRACT(TVAL2,1,$LENGTH(VAL))=VAL

                                       SET APCLER=13

                                       GOTO X6

X6                             QUIT 

                           End DoDot:1

                           IF $DATA(APCLER)

                               GOTO X7

                           SET (FLD,DR)=$ORDER(^DD(FILE,"B",TVAL,""))

                           SET (FN,DIC)=FILE

                           SET DA=PAT

                           SET DIQ="APCL(""DEM"","

                           SET DIQ(0)="E"

                           DO EN^DIQ1

 +1        IF $DATA(APCL("DEM"))

               SET @(APCLY_1_")")=$SELECT($DATA(DT):DT,1:"")_U_APCL("DEM",FN,$ORDER(APCL("DEM",FN,"")),FLD,"E")

               IF $PIECE(@(APCLY_1_")"),U,2)=""

                   KILL @(APCLY_1_")")

 +2       IF '$TEST

               SET APCLER=4

 +3        KILL APCL,DIC,DA,DR,DIQ

X7         QUIT 

 +1       ;