- BDMDM5 ; IHS/CMI/LAB - DM AUDIT ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
- ;
- ;
- EN ;ENTRY POINT FROM BDMDM1
- D HEADER
- D IDENT
- Q
- S BDMAREA=$P(^AUTTAREA($P(^AUTTLOC(DUZ(2),0),U,4),0),U) ;_" - "_$P(^(0),U)
- S BDMSU=$P(^AUTTSU($P(^AUTTLOC(DUZ(2),0),U,5),0),U)
- S BDMFAC=$P(^DIC(4,DUZ(2),0),U)
- I '$D(BDMFISC) D
- . S BDMDTE=BDMBDT_" - "_BDMEDT
- S (^TMP("BDM",$J,1000),^TMP("BDMCUML",$J,1000))=BDMTDTE
- S (^TMP("BDM",$J,1001),^TMP("BDMCUML",$J,1001))=$S($D(BDMDTE):BDMDTE,1:BDMFISC)
- S (^TMP("BDM",$J,1002),^TMP("BDMCUML",$J,1002))=BDMAREA
- S (^TMP("BDM",$J,1003),^TMP("BDMCUML",$J,1003))=BDMSU
- S (^TMP("BDM",$J,1004),^TMP("BDMCUML",$J,1004))=BDMFAC
- S (^TMP("BDM",$J,1005),^TMP("BDMCUML",$J,1005))=$P(^VA(200,DUZ,0),U)
- S ^TMP("BDM",$J,42)=$$FMTE^XLFDT(BDMED)
- S BDMUED=$S(BDMED>DT:DT,1:BDMED)
- Q
- ;
- IDENT ; Pt identifying factors
- I BDMCUML S ^(1)=$G(^TMP("BDMCUML",$J,1))+1
- S Y=$P(^DPT(BDMPD,0),U,3) D DD^%DT
- S ^TMP("BDM",$J,500)=$P($G(^AUPNPAT(BDMPD,41,DUZ(2),0)),U,2)
- S ^TMP("BDM",$J,501)=Y
- S (^TMP("BDM",$J,502),BDMSEX)=$P(^DPT(BDMPD,0),U,2)
- S ^TMP("BDM",$J,504)=$P(^DPT(BDMPD,0),U)
- I BDMCUML D S BDMSUB=2 D CUML
- . I BDMSEX="F" S BDMGOT1=1
- . E S BDMGOT1=0
- S (BDMAGE,^TMP("BDM",$J,503))=(BDMED-$P(^DPT(BDMPD,0),U,3))\10000 I BDMCUML D
- . I BDMAGE<15 S BDMGOT1=1,BDMSUB=50 D CUML F BDMSUB=51,52,53 S BDMGOT1=0 D CUML
- . I BDMAGE>14&(BDMAGE<45) S BDMGOT1=1,BDMSUB=51 D CUML F BDMSUB=50,52,53 S BDMGOT1=0 D CUML
- . I BDMAGE>44&(BDMAGE<65) S BDMGOT1=1,BDMSUB=52 D CUML F BDMSUB=50,51,53 S BDMGOT1=0 D CUML
- . I BDMAGE>64 S BDMGOT1=1,BDMSUB=53 D CUML F BDMSUB=50,51,52 S BDMGOT1=0 D CUML
- K BDMAGE
- Q
- ;
- CUML ; - ENTRY POINT - Set cumulative nodes
- I '$D(^TMP("BDMCUML",$J,BDMSUB)) S ^TMP("BDMCUML",$J,BDMSUB)=BDMGOT1_"/"_1
- E S ^(BDMSUB)=$S(BDMGOT1:$P(^TMP("BDMCUML",$J,BDMSUB),"/")+1,1:$P(^TMP("BDMCUML",$J,BDMSUB),"/"))_"/"_($P(^(BDMSUB),"/",2)+1)
- Q
- ;
- CLEAN ;EP
- K ^TMP("BDMDM FETCH",$J),^TMP("BDMDM DXVS",$J),^TMP("BDMDM VST",$J)
- K BDMDX,BDMVST,BDMDXVS,BDMHT,BDMMEAS,BDML,BDMTOT,BDMMDFN,BDMVDFN,BDMYES,BDMPOD,BDMCL1,BDMCL2,BDMX,BDMY,BDMEYE1,BDMEYE2,BDMPCL1,BDMPCL2,BDMPCL3,BDMPRD,BDMPRV,BDMTD,BDMFDX
- K BDMDAYS,BDMDP,BDMHTK1
- K BDMAREA,BDMSU,BDMFAC,BDMDTE,BDMI,BDMSEX,BDMSUB,BDMGOT1,BDMER,BDMERTX,BDMHTNE,BDMDOO,BDMLL,BDMPCL
- K BDMRTYP,BDMVMED,BDMW
- Q
- ;
- BDMDM5 ; IHS/CMI/LAB - DM AUDIT ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
- +2 ;
- +3 ;
- EN ;ENTRY POINT FROM BDMDM1
- +1 DO HEADER
- +2 DO IDENT
- +3 QUIT
- +1 ;_" - "_$P(^(0),U)
- SET BDMAREA=$PIECE(^AUTTAREA($PIECE(^AUTTLOC(DUZ(2),0),U,4),0),U)
- +2 SET BDMSU=$PIECE(^AUTTSU($PIECE(^AUTTLOC(DUZ(2),0),U,5),0),U)
- +3 SET BDMFAC=$PIECE(^DIC(4,DUZ(2),0),U)
- +4 IF '$DATA(BDMFISC)
- Begin DoDot:1
- +5 SET BDMDTE=BDMBDT_" - "_BDMEDT
- End DoDot:1
- +6 SET (^TMP("BDM",$JOB,1000),^TMP("BDMCUML",$JOB,1000))=BDMTDTE
- +7 SET (^TMP("BDM",$JOB,1001),^TMP("BDMCUML",$JOB,1001))=$SELECT($DATA(BDMDTE):BDMDTE,1:BDMFISC)
- +8 SET (^TMP("BDM",$JOB,1002),^TMP("BDMCUML",$JOB,1002))=BDMAREA
- +9 SET (^TMP("BDM",$JOB,1003),^TMP("BDMCUML",$JOB,1003))=BDMSU
- +10 SET (^TMP("BDM",$JOB,1004),^TMP("BDMCUML",$JOB,1004))=BDMFAC
- +11 SET (^TMP("BDM",$JOB,1005),^TMP("BDMCUML",$JOB,1005))=$PIECE(^VA(200,DUZ,0),U)
- +12 SET ^TMP("BDM",$JOB,42)=$$FMTE^XLFDT(BDMED)
- +13 SET BDMUED=$SELECT(BDMED>DT:DT,1:BDMED)
- +14 QUIT
- +15 ;
- IDENT ; Pt identifying factors
- +1 IF BDMCUML
- SET ^(1)=$GET(^TMP("BDMCUML",$JOB,1))+1
- +2 SET Y=$PIECE(^DPT(BDMPD,0),U,3)
- DO DD^%DT
- +3 SET ^TMP("BDM",$JOB,500)=$PIECE($GET(^AUPNPAT(BDMPD,41,DUZ(2),0)),U,2)
- +4 SET ^TMP("BDM",$JOB,501)=Y
- +5 SET (^TMP("BDM",$JOB,502),BDMSEX)=$PIECE(^DPT(BDMPD,0),U,2)
- +6 SET ^TMP("BDM",$JOB,504)=$PIECE(^DPT(BDMPD,0),U)
- +7 IF BDMCUML
- Begin DoDot:1
- +8 IF BDMSEX="F"
- SET BDMGOT1=1
- +9 IF '$TEST
- SET BDMGOT1=0
- End DoDot:1
- SET BDMSUB=2
- DO CUML
- +10 SET (BDMAGE,^TMP("BDM",$JOB,503))=(BDMED-$PIECE(^DPT(BDMPD,0),U,3))\10000
- IF BDMCUML
- Begin DoDot:1
- +11 IF BDMAGE<15
- SET BDMGOT1=1
- SET BDMSUB=50
- DO CUML
- FOR BDMSUB=51,52,53
- SET BDMGOT1=0
- DO CUML
- +12 IF BDMAGE>14&(BDMAGE<45)
- SET BDMGOT1=1
- SET BDMSUB=51
- DO CUML
- FOR BDMSUB=50,52,53
- SET BDMGOT1=0
- DO CUML
- +13 IF BDMAGE>44&(BDMAGE<65)
- SET BDMGOT1=1
- SET BDMSUB=52
- DO CUML
- FOR BDMSUB=50,51,53
- SET BDMGOT1=0
- DO CUML
- +14 IF BDMAGE>64
- SET BDMGOT1=1
- SET BDMSUB=53
- DO CUML
- FOR BDMSUB=50,51,52
- SET BDMGOT1=0
- DO CUML
- End DoDot:1
- +15 KILL BDMAGE
- +16 QUIT
- +17 ;
- CUML ; - ENTRY POINT - Set cumulative nodes
- +1 IF '$DATA(^TMP("BDMCUML",$JOB,BDMSUB))
- SET ^TMP("BDMCUML",$JOB,BDMSUB)=BDMGOT1_"/"_1
- +2 IF '$TEST
- SET ^(BDMSUB)=$SELECT(BDMGOT1:$PIECE(^TMP("BDMCUML",$JOB,BDMSUB),"/")+1,1:$PIECE(^TMP("BDMCUML",$JOB,BDMSUB),"/"))_"/"_($PIECE(^(BDMSUB),"/",2)+1)
- +3 QUIT
- +4 ;
- CLEAN ;EP
- +1 KILL ^TMP("BDMDM FETCH",$JOB),^TMP("BDMDM DXVS",$JOB),^TMP("BDMDM VST",$JOB)
- +2 KILL BDMDX,BDMVST,BDMDXVS,BDMHT,BDMMEAS,BDML,BDMTOT,BDMMDFN,BDMVDFN,BDMYES,BDMPOD,BDMCL1,BDMCL2,BDMX,BDMY,BDMEYE1,BDMEYE2,BDMPCL1,BDMPCL2,BDMPCL3,BDMPRD,BDMPRV,BDMTD,BDMFDX
- +3 KILL BDMDAYS,BDMDP,BDMHTK1
- +4 KILL BDMAREA,BDMSU,BDMFAC,BDMDTE,BDMI,BDMSEX,BDMSUB,BDMGOT1,BDMER,BDMERTX,BDMHTNE,BDMDOO,BDMLL,BDMPCL
- +5 KILL BDMRTYP,BDMVMED,BDMW
- +6 QUIT
- +7 ;
