APCLDM.m

APCLDM ; IHS/CMI/LAB -IHS -DIABETES QA REPORT ; 

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

 ;

 S X="APCL DIABETES PROGRAM QA AUDIT",DIC="^APCLRPT(",DIC(0)="FM" D ^DIC I Y=-1 W !,*7,"DIABETES PROGRAM QA AUDIT REPORT NOT AVAILABLE" H 2 K DIC,X,Y Q

 S APCL1=+Y

 S X="APCL CUMULATIVE DIABETES QA" D ^DIC I Y=-1 S APCL2=0 K DIC,X,Y

 I Y>0 S APCL2=+Y K Y

 S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Official Diabetes Register: " D ^DIC

 I Y=-1 S APCLDMRG="" W !,"NO Register Selected!!!  The CMS register will not be used in retrieving",!,"any data." G GO

 S APCLDMRG=+Y

GO ;EP - called from bdm

 K APCLPTS

 D START1^APCLASK(APCL1,APCL2) K APCL1,APCL2

 K APCLPTS,APCLDMRG,APCLCUML,APCLDOO

 Q

REC(DFN,APCLRTYP) ;EP - called to send back a visit record as

 NEW APCLX,APCLREC

 S APCLREC=""

 S APCLRTYP("IEN")=$O(^APCLRECD("B",APCLRTYP,0))

 I 'APCLRTYP("IEN") Q APCLREC

PROC ;

 S APCLX=0

 F  S APCLX=$O(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX)) Q:APCLX'=+APCLX!(APCLREC=-1)  S APCL=$O(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX,0))  D

 .S X="" X:$D(^APCLRECD(APCLRTYP("IEN"),11,APCL,11)) ^APCLRECD(APCLRTYP("IEN"),11,APCL,11)

 .I X["-1" S APCLREC=-1 Q

 .;I X="",$P(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,5) S APCLREC=-1 Q

 .I X'[-1 S $E(APCLREC,$P(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,2))=X

 Q APCLREC

WRITEF ;EP write flat file

 K ^TMP($J,"APCL EPI")

 Q:'$D(^TMP("APCLEPI",$J))

 ;load in epi definition to ^TMP($J,"APCL EPI"

 S (X,N)=0 F  S X=$O(^APCLRECD(4,13,X)) Q:X'=+X  S N=N+1,^TMP($J,"APCL EPI",N)=^APCLRECD(4,13,X,0)

 ;MOVE RECORDS TO ^TMP($J,"APCL EPI"

 S X=0 F  S X=$O(^TMP("APCLEPI",$J,X)) Q:X'=+X  S N=N+1,^TMP($J,"APCL EPI",N)=^TMP("APCLEPI",$J,X)

 S XBGL="TMP("_$J_",""APCL EPI"","

 S XBMED="F",XBFN=APCLFILE,XBTLE="SAVE OF DM AUDIT EPI INFO RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)

 S XBF=0,XBQ="N",XBFLT=1,XBE=$J

 D ^XBGSAVE

 ;check for error

 K ^TMP($J,"APCL EPI")

 K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT

 Q

APCLDM    ; IHS/CMI/LAB -IHS -DIABETES QA REPORT ; 

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

 +2       ;

 +3        SET X="APCL DIABETES PROGRAM QA AUDIT"

           SET DIC="^APCLRPT("

           SET DIC(0)="FM"

           DO ^DIC

           IF Y=-1

               WRITE !,*7,"DIABETES PROGRAM QA AUDIT REPORT NOT AVAILABLE"

               HANG 2

               KILL DIC,X,Y

               QUIT 

 +4        SET APCL1=+Y

 +5        SET X="APCL CUMULATIVE DIABETES QA"

           DO ^DIC

           IF Y=-1

               SET APCL2=0

               KILL DIC,X,Y

 +6        IF Y>0

               SET APCL2=+Y

               KILL Y

 +7        SET DIC="^ACM(41.1,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter the Official Diabetes Register: "

           DO ^DIC

 +8        IF Y=-1

               SET APCLDMRG=""

               WRITE !,"NO Register Selected!!!  The CMS register will not be used in retrieving",!,"any data."

               GOTO GO

 +9        SET APCLDMRG=+Y

GO        ;EP - called from bdm

 +1        KILL APCLPTS

 +2        DO START1^APCLASK(APCL1,APCL2)

           KILL APCL1,APCL2

 +3        KILL APCLPTS,APCLDMRG,APCLCUML,APCLDOO

 +4        QUIT 

REC(DFN,APCLRTYP) ;EP - called to send back a visit record as

 +1        NEW APCLX,APCLREC

 +2        SET APCLREC=""

 +3        SET APCLRTYP("IEN")=$ORDER(^APCLRECD("B",APCLRTYP,0))

 +4        IF 'APCLRTYP("IEN")

               QUIT APCLREC

PROC      ;

 +1        SET APCLX=0

 +2        FOR 

               SET APCLX=$ORDER(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX))

               IF APCLX'=+APCLX!(APCLREC=-1)

                   QUIT 

               SET APCL=$ORDER(^APCLRECD(APCLRTYP("IEN"),11,"AC",APCLX,0))

               Begin DoDot:1

 +3                SET X=""

                   IF $DATA(^APCLRECD(APCLRTYP("IEN"),11,APCL,11))

                       XECUTE ^APCLRECD(APCLRTYP("IEN"),11,APCL,11)

 +4                IF X["-1"

                       SET APCLREC=-1

                       QUIT 

 +5       ;I X="",$P(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,5) S APCLREC=-1 Q

 +6                IF X'[-1

                       SET $EXTRACT(APCLREC,$PIECE(^APCLRECD(APCLRTYP("IEN"),11,APCL,0),U,2))=X

               End DoDot:1

 +7        QUIT APCLREC

WRITEF    ;EP write flat file

 +1        KILL ^TMP($JOB,"APCL EPI")

 +2        IF '$DATA(^TMP("APCLEPI",$JOB))

               QUIT 

 +3       ;load in epi definition to ^TMP($J,"APCL EPI"

 +4        SET (X,N)=0

           FOR 

               SET X=$ORDER(^APCLRECD(4,13,X))

               IF X'=+X

                   QUIT 

               SET N=N+1

               SET ^TMP($JOB,"APCL EPI",N)=^APCLRECD(4,13,X,0)

 +5       ;MOVE RECORDS TO ^TMP($J,"APCL EPI"

 +6        SET X=0

           FOR 

               SET X=$ORDER(^TMP("APCLEPI",$JOB,X))

               IF X'=+X

                   QUIT 

               SET N=N+1

               SET ^TMP($JOB,"APCL EPI",N)=^TMP("APCLEPI",$JOB,X)

 +7        SET XBGL="TMP("_$JOB_",""APCL EPI"","

 +8        SET XBMED="F"

           SET XBFN=APCLFILE

           SET XBTLE="SAVE OF DM AUDIT EPI INFO RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)

 +9        SET XBF=0

           SET XBQ="N"

           SET XBFLT=1

           SET XBE=$JOB

 +10       DO ^XBGSAVE

 +11      ;check for error

 +12       KILL ^TMP($JOB,"APCL EPI")

 +13       KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT

 +14       QUIT