- 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 ;
