BDMDM.m

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

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 ;

 S X="BDM DIABETES PROGRAM QA AUDIT",DIC="^BDMRPT(",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 BDM1=+Y

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

 I Y>0 S BDM2=+Y K Y

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

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

 S BDMDMRG=+Y

GO ;

 K BDMPTS

 D START1^BDMASK(BDM1,BDM2) K BDM1,BDM2

 K BDMPTS,BDMDMRG,BDMCUML,BDMDOO

 Q

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

 NEW BDMX,BDMREC

 S BDMREC=""

 S BDMRTYP("IEN")=$O(^BDMRECD("B",BDMRTYP,0))

 I 'BDMRTYP("IEN") Q BDMREC

PROC ;

 S BDMX=0

 F  S BDMX=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMX)) Q:BDMX'=+BDMX!(BDMREC=-1)  S BDM=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMX,0))  D

 .S X="" X:$D(^BDMRECD(BDMRTYP("IEN"),11,BDM,11)) ^BDMRECD(BDMRTYP("IEN"),11,BDM,11)

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

 .;I X="",$P(^BDMRECD(BDMRTYP("IEN"),11,BDM,0),U,5) S BDMREC=-1 Q

 .I X'[-1 S $E(BDMREC,$P(^BDMRECD(BDMRTYP("IEN"),11,BDM,0),U,2))=X

 Q BDMREC

WRITEF ;EP write flat file

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

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

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

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

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

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

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

 S XBMED="F",XBFN=BDMFILE,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,"BDM EPI")

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

 Q

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

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 +2       ;

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

           SET DIC="^BDMRPT("

           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 BDM1=+Y

 +5        SET X="BDM CUMULATIVE DIABETES QA"

           DO ^DIC

           IF Y=-1

               SET BDM2=0

               KILL DIC,X,Y

 +6        IF Y>0

               SET BDM2=+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 BDMDMRG=""

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

               GOTO GO

 +9        SET BDMDMRG=+Y

GO        ;

 +1        KILL BDMPTS

 +2        DO START1^BDMASK(BDM1,BDM2)

           KILL BDM1,BDM2

 +3        KILL BDMPTS,BDMDMRG,BDMCUML,BDMDOO

 +4        QUIT 

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

 +1        NEW BDMX,BDMREC

 +2        SET BDMREC=""

 +3        SET BDMRTYP("IEN")=$ORDER(^BDMRECD("B",BDMRTYP,0))

 +4        IF 'BDMRTYP("IEN")

               QUIT BDMREC

PROC      ;

 +1        SET BDMX=0

 +2        FOR 

               SET BDMX=$ORDER(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMX))

               IF BDMX'=+BDMX!(BDMREC=-1)

                   QUIT 

               SET BDM=$ORDER(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMX,0))

               Begin DoDot:1

 +3                SET X=""

                   IF $DATA(^BDMRECD(BDMRTYP("IEN"),11,BDM,11))

                       XECUTE ^BDMRECD(BDMRTYP("IEN"),11,BDM,11)

 +4                IF X["-1"

                       SET BDMREC=-1

                       QUIT 

 +5       ;I X="",$P(^BDMRECD(BDMRTYP("IEN"),11,BDM,0),U,5) S BDMREC=-1 Q

 +6                IF X'[-1

                       SET $EXTRACT(BDMREC,$PIECE(^BDMRECD(BDMRTYP("IEN"),11,BDM,0),U,2))=X

               End DoDot:1

 +7        QUIT BDMREC

WRITEF    ;EP write flat file

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

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

               QUIT 

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

 +4        SET (X,N)=0

           FOR 

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

               IF X'=+X

                   QUIT 

               SET N=N+1

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

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

 +6        SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               SET N=N+1

               SET ^TMP($JOB,"BDM EPI",N)=^TMP("BDMEPI",$JOB,X)

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

 +8        SET XBMED="F"

           SET XBFN=BDMFILE

           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,"BDM EPI")

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

 +14       QUIT