- 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
