BKMVQCR ;VNGT/HS/ALA-Quality of Care Report Roll&Scroll ; 20 Jun 2011 12:38 PM
;;2.1;HIV MANAGEMENT SYSTEM;**1**;FEB 7, 2011;Build 30
Q
;
EN(REG) ;EP - Primary
NEW BACK,BKMRPOP,EDATE,BKMTAG,BQDFN,PN,QFL,DIR,DTOUT,DUOUT,Y,X
EN1 ;
S BACK=0
;D NOW^%DTC
S BKMRPOP=$$SELPOP()
I BKMRPOP=""!(BKMRPOP="^") G XIT
;Active HIV/AIDS Diagnostic Tag
I BKMRPOP="D" D ACT I $D(DTOUT)!$D(DUOUT) G XIT
; Selected Patient(s)
I BKMRPOP="P" D PTL
;
D ENDATE
I EDATE=-1 G XIT
D RUN^BKMQQCR(.DATA,BKMRPOP,EDATE,$G(OWNR),$G(PLIEN),$G(BKMTAG),.BQDFN,1)
;
EN3 ; print the report
D ^%ZIS
I IOST["C-" W @IOF
S PN=0,QFL=0
F S PN=$O(^TMP("BQIQOC",$J,PN)) Q:'PN!(QFL) D
. I (IOSL-$Y)<6 D Q:QFL
.. I IOST["C-",$$PAUSE^BKMIXX3 W @IOF I X="^" S QFL=1 Q
.. W @IOF
. U IO W !,^TMP("BQIQOC",$J,PN)
D CLEAN,^%ZISC,XIT
Q
;
SELPOP() ; Select Report population
SELPOP1 ; GOTO return
K DIR
S DIR("A")="Report Population"
S DIR(0)="SO^D:Active HIV/AIDS Diagnostic Tag;R:Active HMS Register Patients;P:Selected Patient(s)"
D ^DIR I $D(DTOUT)!$D(DUOUT) S Y=""
I '(",R,P,D,"[(","_Y_",")) G SELPOP1
Q Y
;
ENDATE ; ending date selection
NEW %DT,Y
S %DT="AE"
S %DT("A")="Select ending date for report: ",%DT("B")="TODAY"
D ^%DT
S EDATE=Y
Q
;
ACT ; Diagnostic Tag Status
K DIR
S DIR("A")="Select Diagnostic Tag Status"
S DIR(0)="SO^A:Accepted;P:Proposed;B:Proposed and Accepted"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q
I Y="" S BACK=1 Q
S BKMTAG=Y
Q
;
CLEAN ;clean up variables
K ^TMP("BQIQOC",$J)
Q
XIT ;
D ^XBFMK
Q
DICW ;EP - This is a specially written FileMan 'WRITE' statement
N NZ,NAME,COUNTY,STATE,CODE,STCTYCOM
S NZ=$G(^(0))
S NAME=$P(NZ,U)
S COUNTY=$P(NZ,U,2) I COUNTY'="" S COUNTY=$P($G(^AUTTCTY(COUNTY,0)),U)
S STATE=$P(NZ,U,3) I STATE'="" S STATE=$P($G(^DIC(5,STATE,0)),U)
S CODE=$P(NZ,U,7)
S STCTYCOM=$P(NZ,U,8)
S COUNTY=$J($E(COUNTY,1,15),15)
S STATE=$J($E(STATE,1,17),17)
S CODE=$J($E(CODE,1,6),6)
S STCTYCOM=$J($E(STCTYCOM,1,10),10)
W ?27,COUNTY," ",STATE," ",CODE," ",STCTYCOM
Q
;
PTL ; Patient Lookup
D PLK^BKMPLKP
I $G(DFN)="" Q
S BQDFN(DFN)=""
G PTL
BKMVQCR ;VNGT/HS/ALA-Quality of Care Report Roll&Scroll ; 20 Jun 2011 12:38 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;**1**;FEB 7, 2011;Build 30
+2 QUIT
+3 ;
EN(REG) ;EP - Primary
+1 NEW BACK,BKMRPOP,EDATE,BKMTAG,BQDFN,PN,QFL,DIR,DTOUT,DUOUT,Y,X
EN1 ;
+1 SET BACK=0
+2 ;D NOW^%DTC
+3 SET BKMRPOP=$$SELPOP()
+4 IF BKMRPOP=""!(BKMRPOP="^")
GOTO XIT
+5 ;Active HIV/AIDS Diagnostic Tag
+6 IF BKMRPOP="D"
DO ACT
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
+7 ; Selected Patient(s)
+8 IF BKMRPOP="P"
DO PTL
+9 ;
+10 DO ENDATE
+11 IF EDATE=-1
GOTO XIT
+12 DO RUN^BKMQQCR(.DATA,BKMRPOP,EDATE,$GET(OWNR),$GET(PLIEN),$GET(BKMTAG),.BQDFN,1)
+13 ;
EN3 ; print the report
+1 DO ^%ZIS
+2 IF IOST["C-"
WRITE @IOF
+3 SET PN=0
SET QFL=0
+4 FOR
SET PN=$ORDER(^TMP("BQIQOC",$JOB,PN))
IF 'PN!(QFL)
QUIT
Begin DoDot:1
+5 IF (IOSL-$Y)<6
Begin DoDot:2
+6 IF IOST["C-"
IF $$PAUSE^BKMIXX3
WRITE @IOF
IF X="^"
SET QFL=1
QUIT
+7 WRITE @IOF
End DoDot:2
IF QFL
QUIT
+8 USE IO
WRITE !,^TMP("BQIQOC",$JOB,PN)
End DoDot:1
+9 DO CLEAN
DO ^%ZISC
DO XIT
+10 QUIT
+11 ;
SELPOP() ; Select Report population
SELPOP1 ; GOTO return
+1 KILL DIR
+2 SET DIR("A")="Report Population"
+3 SET DIR(0)="SO^D:Active HIV/AIDS Diagnostic Tag;R:Active HMS Register Patients;P:Selected Patient(s)"
+4 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y=""
+5 IF '(",R,P,D,"[(","_Y_","))
GOTO SELPOP1
+6 QUIT Y
+7 ;
ENDATE ; ending date selection
+1 NEW %DT,Y
+2 SET %DT="AE"
+3 SET %DT("A")="Select ending date for report: "
SET %DT("B")="TODAY"
+4 DO ^%DT
+5 SET EDATE=Y
+6 QUIT
+7 ;
ACT ; Diagnostic Tag Status
+1 KILL DIR
+2 SET DIR("A")="Select Diagnostic Tag Status"
+3 SET DIR(0)="SO^A:Accepted;P:Proposed;B:Proposed and Accepted"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 IF Y=""
SET BACK=1
QUIT
+7 SET BKMTAG=Y
+8 QUIT
+9 ;
CLEAN ;clean up variables
+1 KILL ^TMP("BQIQOC",$JOB)
+2 QUIT
XIT ;
+1 DO ^XBFMK
+2 QUIT
DICW ;EP - This is a specially written FileMan 'WRITE' statement
+1 NEW NZ,NAME,COUNTY,STATE,CODE,STCTYCOM
+2 SET NZ=$GET(^(0))
+3 SET NAME=$PIECE(NZ,U)
+4 SET COUNTY=$PIECE(NZ,U,2)
IF COUNTY'=""
SET COUNTY=$PIECE($GET(^AUTTCTY(COUNTY,0)),U)
+5 SET STATE=$PIECE(NZ,U,3)
IF STATE'=""
SET STATE=$PIECE($GET(^DIC(5,STATE,0)),U)
+6 SET CODE=$PIECE(NZ,U,7)
+7 SET STCTYCOM=$PIECE(NZ,U,8)
+8 SET COUNTY=$JUSTIFY($EXTRACT(COUNTY,1,15),15)
+9 SET STATE=$JUSTIFY($EXTRACT(STATE,1,17),17)
+10 SET CODE=$JUSTIFY($EXTRACT(CODE,1,6),6)
+11 SET STCTYCOM=$JUSTIFY($EXTRACT(STCTYCOM,1,10),10)
+12 WRITE ?27,COUNTY," ",STATE," ",CODE," ",STCTYCOM
+13 QUIT
+14 ;
PTL ; Patient Lookup
+1 DO PLK^BKMPLKP
+2 IF $GET(DFN)=""
QUIT
+3 SET BQDFN(DFN)=""
+4 GOTO PTL
