BZXMIHDR ;IHS/PIMC/JLG- HEALTH DEPARTMENT REPORT ; 12/2/03
;;5.1;LAB;;04/11/91 11:06
;;;IHS/PIMC/JLG - 12/2/03 Restructuring and revision without commenting at each place.
;SLC/CJS,BA- HEALTH DEPARTMENT REPORT ;2/19/91
;MODIFIED BY WALZ
;;;IHS/PIMC/vjm - 7/24/01 added INTROTXT sub-rtn
;
Q:$D(BZX("QUIT")) ; var will be set if '^' out of the Gila River
; ; intro text DIR response - option: BZXX DWMIHDR1
K ^UTILITY("MI",$J)
;
; start - vjm 4/14/2000 - setting subscript variable
S BZXSBSCR="MI"
; end - vjm 4/14/2000
;
I '$D(DT) W !,"VARIABLE DT NOT DEFINED ABORTING" Q
;Begin modified code IHS/PIMC/JLG 12/6/00
BEGIN S LREND=0,LREDT="T-1"
D ^LRWU3
I 'LREND D
.S ZTRTN="DQ^BZXMIHDR"
.S ZTSAVE("BZX*")=""
.D IO^LRWU
;End modified code 12/6/00
END K %DT,A,AGE,D0,DA,DFN,DIC,DL,DOB,DR,DX,I,LRACC,LRBUG,LROCCU,LRDFN,LRDPF,LRDT,LREDT,LREND,LRHC,LRIDT,LRMARST,DWSAMP,LRPHONE,LRRACE,LRSAMP,LRSDT,LRSPEC,LRWRD,POP,PNM,S,SEX,SSN,HRCN,X,Y,Z0,DWLOC ;IHS/ANMC/CLS 10/03/92 HRCN
K DWPROV,DWPROVN,DWCOLDT,PEDT,PSDT,DWCITY,DWSTR,DWSTATE,DWPROV,DWBUG,DWCMPLDT,DWCOL,DWCPL,DWSTATN,DWZIP,FOOTFLG,II,III,LI,PG,PGM,PLG,PP,RACC,RPNM,J
;
; start - vjm 4/14/2000 - killing BZX variables
K BZXCOMM,BZX,BZXSBSCR
; end - vjm 4/14/2000
;
K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK D ^%ZISC
Q
DQ K ^UTILITY("MI",$J)
S FOOTFLG=0,PEDT=$E(LREDT,4,5)_"/"_$E(LREDT,6,7)_"/"_$E(LREDT,2,3),PSDT=$E(LRSDT,4,5)_"/"_$E(LRSDT,6,7)_"/"_$E(LRSDT,2,3)
D:$D(ZTSK) KILL^%ZTLOAD K ZTSK U IO
S LRDT=LREDT-.0001 F I=0:0 S LRDT=$O(^LR("AD",LRDT)) Q:LRDT<1!(LRDT>LRSDT) D DATE Q:LREND
D PREPORT
Q
DATE ;S DR=.11
S LRBUG=0 F I=0:0 S LRBUG=$O(^LR("AD",LRDT,LRBUG)) Q:LRBUG<1 D LIST Q:LREND
Q
LIST ;
S LRACC="" F I=0:0 S LRACC=$O(^LR("AD",LRDT,LRBUG,LRACC)) Q:LRACC="" S LRDFN=^(LRACC) D SPEC,PAT,SETNODE
Q
SPEC S (LRIDT,LRSPEC,LRSAMP)=0 F I=0:0 S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1 D Q:LRSPEC
.I $D(^LR(LRDFN,"MI",LRIDT,0)),$E(LRACC,1,$L(LRACC)-1)=$P(^LR(LRDFN,"MI",LRIDT,0),U,6) D
..S LRSPEC=+$P(^LR(LRDFN,"MI",LRIDT,0),U,5),LRSAMP=+$P(^(0),U,11),DWPROVN=+$P(^(0),U,7),DWCOLDT=+$P(^(0),U,1)
..S DWCMPLDT=$S($D(^LR(LRDFN,"MI",LRIDT,1)):+$P(^(1),U,1),$D(^(11)):+$P(^(11),U,1),$D(^(5)):+$P(^(5),U,1),$D(^(8)):+$P(^(8),U,1),$D(^(16)):+$P(^(16),U,1),1:"")
..S DWLOC=$P(^LR(LRDFN,"MI",LRIDT,0),U,8)
S DWPROV="" S:DWPROVN>0&($D(^VA(200,DWPROVN,0))) DWPROV=$P(^VA(200,DWPROVN,0),U,1)
S DWSAMP="" I LRSAMP,$D(^LAB(62,LRSAMP,0)) S DWSAMP=$P(^(0),U)
Q
PAT S LRDPF=$P(^LR(LRDFN,0),U,2) Q:LRDPF=67.1 ;quit if research entry from file 67.1
;
; start - vjm 5/11/2000
S DFN=$P(^LR(LRDFN,0),U,3)
I LRDPF=2 D BZXGR^BZXLRGR ;To print all communities, only defined for file 2
S DIC=^DIC(+LRDPF,0,"GL")
D PT^LRX
; end - vjm 5/11/2000
;
S X=DIC_DFN_",.13)"
S LRPHONE=$S($D(@X):$P(^(.13),U),1:""),LRRACE=$P(DIC_DFN_",0)",U,6),LRMARST=$P(^(0),U,5),LROCCU=$P(^(0),U,7)
S (DWSTR,DWCITY,DWSTATN,DWZIP,DWSTATE)=""
;Begin mods to fix missing state IHS/PIMC/JLG 12/1/03
;I $D(^DPT(DFN,.11)) S DWSTR=$P(^DPT(DFN,.11),"^",1),DWCITY=$P(^(.11),"^",4),DWSTATN=+$P(^(.11),"^",5),DWZIP=$P(^(.11),"^",6),DWSTATE=$P(^DIC(5,DWSTATN,0),"^",1)
I $D(^DPT(DFN,.11)) D
.S DWSTR=$P(^DPT(DFN,.11),"^",1),DWCITY=$P(^(.11),"^",4),DWSTATN=+$P(^(.11),"^",5),DWZIP=$P(^(.11),"^",6)
.I DWSTATN S DWSTATE=$P(^DIC(5,DWSTATN,0),"^",1)
.E S DWSTATE="No state"
;End changes
Q
SETNODE ;
; start - vjm 5/11/2000 adding comm to the ^UTILITY temp gbl
D MICOMM^BZXLRGR ;IHS/PIMC/JLG 12/6/00
Q ;IHS/PIMC/JLG 12/6/00
; end - vjm 5/11/2000
;
PREPORT ;
; start - vjm 5/17/2000 - do Do block if no data to report
I '$D(^UTILITY("MI",$J)) D Q
. S PG=1
. D RHEAD
. K PG
. W !?35,"**** NO DATA TO REPORT **** "
. W @IOF
. Q
; end - vjm 5/17/2000
;
S PG=1,DWBUG="" F I=0:0 S DWBUG=$O(^UTILITY("MI",$J,DWBUG)) Q:DWBUG="" D RLOOP1
D FOOTER W @IOF
K ^UTILITY("MI",$J)
Q
RLOOP1 D:FOOTFLG=1 FOOTER
W @IOF D RHEAD ;W !,"Reporting Organism: "_DWBUG,!
S RPNM="" F II=0:0 S RPNM=$O(^UTILITY("MI",$J,DWBUG,RPNM)) Q:RPNM="" D RLOOP2
Q
RLOOP2 S RACC="" F III=0:0 S RACC=$O(^UTILITY("MI",$J,DWBUG,RPNM,RACC)) Q:RACC="" D PRTIT
Q
PRTIT ; print patient data
W !!,$E(RPNM,1,28) ;NAME
W ?30,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",6) ;HRN
W ?40,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",7) ;DOB
W ?54,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",8) ;SEX
W ?58,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",4) ;ACCN
W ?70,$E($P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",1),1,12) ;SPEC
S DWCOL=$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",3) W ?84,$E(DWCOL,4,5)_"/"_$E(DWCOL,6,7)_"/"_$E(DWCOL,2,3) ;COL DT
S DWCPL=$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",5) W ?94,$E(DWCPL,4,5)_"/"_$E(DWCPL,6,7)_"/"_$E(DWCPL,2,3) ;CPL DT
W ?106,$E($P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",2),1,25) ;PROV
W !,?5,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",9) ;PHONE
W ?30,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",10) ;STREET
W ?64,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",11) ;CITY
W ?84,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",12) ;STATE
W ?98,$P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",13) ;ZIP
W ?106,$E($P(^UTILITY("MI",$J,DWBUG,RPNM,RACC),"^",14),1,25) ;LOC
;
; start - vjm 5/15/2000 - adding comm to these write statements
D COMM^BZXLRGR ;IHS/PIMC/JLG 12/6/00
; end - vjm
;
I $Y>50 D FOOTER W @IOF D RHEAD
Q
RHEAD W "AZ HEALTH DEPARTMENT REPORT",?51,"Phoenix Indian Medical Center",!,?46,"4212 N. 16th St., Phoenix, AZ 85016",!,"From "_PEDT_" to "_PSDT,?53,"****** CONFIDENTIAL ******",?98,"Printed: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?120,"Page: "_PG,!
W !,"Name",?30,"ID#",?40,"DOB",?54,"Sex",?58,"Lab #",?70,"Sample",?84,"Col Dt",?94,"Cpl Dt",?106,"Provider",!,?5,"Phone #",?30,"Address",?106,"Location"
;
; start - vjm 5/15/2000
;Modified to print current community on all reports
W !?5,"Current Community" ;IHS/PIMC/JLG 12/6/00
; end - vjm
;
W ! F LI=0:1:IOM-1 W ?LI,"-"
W ! S PG=PG+1,FOOTFLG=1
W !,"Reporting Organism: "_DWBUG,!
Q
W "________________________________________ _______________"
W !," Medical Technologist Date"
Q
;
;====================================================================
INTROTXT ; introduction text of this Local Health Department [Gila River] report
;
W !!!
W "This report prints Arizona Health Department organisms which have",!
W "been identified during the date interval selected. The report",!
W "is for patients residing only in selected Gila River communities.",!!
W "NOTE: This report requires a COMPRESSED (132 characters/line) printer!",!!
K DIRUT
S DIR(0)="E",DIR("A")="Press <Return> to continue or '^' to quit"
D ^DIR K DIR,DA
S:$D(DIRUT) BZX("QUIT")=1
Q:$D(BZX("QUIT"))
W:$D(IOF) @IOF
Q
;
;
BZXGR ; processing for Gila River Community pts
; ^BZXGRHD --> BZX DWMIHDR1 GILA RIVER HLTH RPT COMMUNITIES file
;
S BZX("COMM IEN")=0
S BZX("COMM IEN")=$$COMMRES^AUPNPAT(DFN,"I")
;
; do this IF the ptr value for CURRENT COMMUNITY does not exist
I '+BZX("COMM IEN") D
. S BZX("COMM NAME")=$P(^AUPNPAT(DFN,11),U,18)
. S BZX("COMM IEN")=$O(^AUTTCOM("B",BZX("COMM NAME"),0))
. Q
;
; get IEN of the local BZX gila river community list
S BZX("IEN")=$O(^BZXGRHR("B",BZX("COMM IEN"),0))
;
I '+BZX("IEN") D BZXKVARS Q ; QUIT if no entry in local file
S BZXCOMM=$$COMMRES^AUPNPAT(DFN,"E")
D BZXKVARS
Q
BZXKVARS ; clean up the BZX vars
K BZX
Q
; end of routine
BZXMIHDR ;IHS/PIMC/JLG- HEALTH DEPARTMENT REPORT ; 12/2/03
+1 ;;5.1;LAB;;04/11/91 11:06
+2 ;;;IHS/PIMC/JLG - 12/2/03 Restructuring and revision without commenting at each place.
+3 ;SLC/CJS,BA- HEALTH DEPARTMENT REPORT ;2/19/91
+4 ;MODIFIED BY WALZ
+5 ;;;IHS/PIMC/vjm - 7/24/01 added INTROTXT sub-rtn
+6 ;
+7 ; var will be set if '^' out of the Gila River
IF $DATA(BZX("QUIT"))
QUIT
+8 ; ; intro text DIR response - option: BZXX DWMIHDR1
+9 KILL ^UTILITY("MI",$JOB)
+10 ;
+11 ; start - vjm 4/14/2000 - setting subscript variable
+12 SET BZXSBSCR="MI"
+13 ; end - vjm 4/14/2000
+14 ;
+15 IF '$DATA(DT)
WRITE !,"VARIABLE DT NOT DEFINED ABORTING"
QUIT
+16 ;Begin modified code IHS/PIMC/JLG 12/6/00
BEGIN SET LREND=0
SET LREDT="T-1"
+1 DO ^LRWU3
+2 IF 'LREND
Begin DoDot:1
+3 SET ZTRTN="DQ^BZXMIHDR"
+4 SET ZTSAVE("BZX*")=""
+5 DO IO^LRWU
End DoDot:1
+6 ;End modified code 12/6/00
END ;IHS/ANMC/CLS 10/03/92 HRCN
KILL %DT,A,AGE,D0,DA,DFN,DIC,DL,DOB,DR,DX,I,LRACC,LRBUG,LROCCU,LRDFN,LRDPF,LRDT,LREDT,LREND,LRHC,LRIDT,LRMARST,DWSAMP,LRPHONE,LRRACE,LRSAMP,LRSDT,LRSPEC,LRWRD,POP,PNM,S,SEX,SSN,HRCN,X,Y,Z0,DWLOC
+1 KILL DWPROV,DWPROVN,DWCOLDT,PEDT,PSDT,DWCITY,DWSTR,DWSTATE,DWPROV,DWBUG,DWCMPLDT,DWCOL,DWCPL,DWSTATN,DWZIP,FOOTFLG,II,III,LI,PG,PGM,PLG,PP,RACC,RPNM,J
+2 ;
+3 ; start - vjm 4/14/2000 - killing BZX variables
+4 KILL BZXCOMM,BZX,BZXSBSCR
+5 ; end - vjm 4/14/2000
+6 ;
+7 IF $DATA(ZTSK)
KILL ^%ZTSK(ZTSK),ZTSK
DO ^%ZISC
+8 QUIT
DQ KILL ^UTILITY("MI",$JOB)
+1 SET FOOTFLG=0
SET PEDT=$EXTRACT(LREDT,4,5)_"/"_$EXTRACT(LREDT,6,7)_"/"_$EXTRACT(LREDT,2,3)
SET PSDT=$EXTRACT(LRSDT,4,5)_"/"_$EXTRACT(LRSDT,6,7)_"/"_$EXTRACT(LRSDT,2,3)
+2 IF $DATA(ZTSK)
DO KILL^%ZTLOAD
KILL ZTSK
USE IO
+3 SET LRDT=LREDT-.0001
FOR I=0:0
SET LRDT=$ORDER(^LR("AD",LRDT))
IF LRDT<1!(LRDT>LRSDT)
QUIT
DO DATE
IF LREND
QUIT
+4 DO PREPORT
+5 QUIT
DATE ;S DR=.11
+1 SET LRBUG=0
FOR I=0:0
SET LRBUG=$ORDER(^LR("AD",LRDT,LRBUG))
IF LRBUG<1
QUIT
DO LIST
IF LREND
QUIT
+2 QUIT
LIST ;
+1 SET LRACC=""
FOR I=0:0
SET LRACC=$ORDER(^LR("AD",LRDT,LRBUG,LRACC))
IF LRACC=""
QUIT
SET LRDFN=^(LRACC)
DO SPEC
DO PAT
DO SETNODE
+2 QUIT
SPEC SET (LRIDT,LRSPEC,LRSAMP)=0
FOR I=0:0
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
IF LRIDT<1
QUIT
Begin DoDot:1
+1 IF $DATA(^LR(LRDFN,"MI",LRIDT,0))
IF $EXTRACT(LRACC,1,$LENGTH(LRACC)-1)=$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,6)
Begin DoDot:2
+2 SET LRSPEC=+$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,5)
SET LRSAMP=+$PIECE(^(0),U,11)
SET DWPROVN=+$PIECE(^(0),U,7)
SET DWCOLDT=+$PIECE(^(0),U,1)
+3 SET DWCMPLDT=$SELECT($DATA(^LR(LRDFN,"MI",LRIDT,1)):+$PIECE(^(1),U,1),$DATA(^(11)):+$PIECE(^(11),U,1),$DATA(^(5)):+$PIECE(^(5),U,1),$DATA(^(8)):+$PIECE(^(8),U,1),$DATA(^(16)):+$PIECE(^(16),U,1),1:"")
+4 SET DWLOC=$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,8)
End DoDot:2
End DoDot:1
IF LRSPEC
QUIT
+5 SET DWPROV=""
IF DWPROVN>0&($DATA(^VA(200,DWPROVN,0)))
SET DWPROV=$PIECE(^VA(200,DWPROVN,0),U,1)
+6 SET DWSAMP=""
IF LRSAMP
IF $DATA(^LAB(62,LRSAMP,0))
SET DWSAMP=$PIECE(^(0),U)
+7 QUIT
PAT ;quit if research entry from file 67.1
SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
IF LRDPF=67.1
QUIT
+1 ;
+2 ; start - vjm 5/11/2000
+3 SET DFN=$PIECE(^LR(LRDFN,0),U,3)
+4 ;To print all communities, only defined for file 2
IF LRDPF=2
DO BZXGR^BZXLRGR
+5 SET DIC=^DIC(+LRDPF,0,"GL")
+6 DO PT^LRX
+7 ; end - vjm 5/11/2000
+8 ;
+9 SET X=DIC_DFN_",.13)"
+10 SET LRPHONE=$SELECT($DATA(@X):$PIECE(^(.13),U),1:"")
SET LRRACE=$PIECE(DIC_DFN_",0)",U,6)
SET LRMARST=$PIECE(^(0),U,5)
SET LROCCU=$PIECE(^(0),U,7)
+11 SET (DWSTR,DWCITY,DWSTATN,DWZIP,DWSTATE)=""
+12 ;Begin mods to fix missing state IHS/PIMC/JLG 12/1/03
+13 ;I $D(^DPT(DFN,.11)) S DWSTR=$P(^DPT(DFN,.11),"^",1),DWCITY=$P(^(.11),"^",4),DWSTATN=+$P(^(.11),"^",5),DWZIP=$P(^(.11),"^",6),DWSTATE=$P(^DIC(5,DWSTATN,0),"^",1)
+14 IF $DATA(^DPT(DFN,.11))
Begin DoDot:1
+15 SET DWSTR=$PIECE(^DPT(DFN,.11),"^",1)
SET DWCITY=$PIECE(^(.11),"^",4)
SET DWSTATN=+$PIECE(^(.11),"^",5)
SET DWZIP=$PIECE(^(.11),"^",6)
+16 IF DWSTATN
SET DWSTATE=$PIECE(^DIC(5,DWSTATN,0),"^",1)
+17 IF '$TEST
SET DWSTATE="No state"
End DoDot:1
+18 ;End changes
+19 QUIT
SETNODE ;
+1 ; start - vjm 5/11/2000 adding comm to the ^UTILITY temp gbl
+2 ;IHS/PIMC/JLG 12/6/00
DO MICOMM^BZXLRGR
+3 ;IHS/PIMC/JLG 12/6/00
QUIT
+4 ; end - vjm 5/11/2000
+5 +6 ;
PREPORT ;
+1 ; start - vjm 5/17/2000 - do Do block if no data to report
+2 IF '$DATA(^UTILITY("MI",$JOB))
Begin DoDot:1
+3 SET PG=1
+4 DO RHEAD
+5 KILL PG
+6 WRITE !?35,"**** NO DATA TO REPORT **** "
+7 WRITE @IOF
+8 QUIT
End DoDot:1
QUIT
+9 ; end - vjm 5/17/2000
+10 ;
+11 SET PG=1
SET DWBUG=""
FOR I=0:0
SET DWBUG=$ORDER(^UTILITY("MI",$JOB,DWBUG))
IF DWBUG=""
QUIT
DO RLOOP1
+12 DO FOOTER
WRITE @IOF
+13 KILL ^UTILITY("MI",$JOB)
+14 QUIT
RLOOP1 IF FOOTFLG=1
DO FOOTER
+1 ;W !,"Reporting Organism: "_DWBUG,!
WRITE @IOF
DO RHEAD
+2 SET RPNM=""
FOR II=0:0
SET RPNM=$ORDER(^UTILITY("MI",$JOB,DWBUG,RPNM))
IF RPNM=""
QUIT
DO RLOOP2
+3 QUIT
RLOOP2 SET RACC=""
FOR III=0:0
SET RACC=$ORDER(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC))
IF RACC=""
QUIT
DO PRTIT
+1 QUIT
PRTIT ; print patient data
+1 ;NAME
WRITE !!,$EXTRACT(RPNM,1,28)
+2 ;HRN
WRITE ?30,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",6)
+3 ;DOB
WRITE ?40,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",7)
+4 ;SEX
WRITE ?54,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",8)
+5 ;ACCN
WRITE ?58,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",4)
+6 ;SPEC
WRITE ?70,$EXTRACT($PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",1),1,12)
+7 ;COL DT
SET DWCOL=$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",3)
WRITE ?84,$EXTRACT(DWCOL,4,5)_"/"_$EXTRACT(DWCOL,6,7)_"/"_$EXTRACT(DWCOL,2,3)
+8 ;CPL DT
SET DWCPL=$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",5)
WRITE ?94,$EXTRACT(DWCPL,4,5)_"/"_$EXTRACT(DWCPL,6,7)_"/"_$EXTRACT(DWCPL,2,3)
+9 ;PROV
WRITE ?106,$EXTRACT($PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",2),1,25)
+10 ;PHONE
WRITE !,?5,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",9)
+11 ;STREET
WRITE ?30,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",10)
+12 ;CITY
WRITE ?64,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",11)
+13 ;STATE
WRITE ?84,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",12)
+14 ;ZIP
WRITE ?98,$PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",13)
+15 ;LOC
WRITE ?106,$EXTRACT($PIECE(^UTILITY("MI",$JOB,DWBUG,RPNM,RACC),"^",14),1,25)
+16 ;
+17 ; start - vjm 5/15/2000 - adding comm to these write statements
+18 ;IHS/PIMC/JLG 12/6/00
DO COMM^BZXLRGR
+19 ; end - vjm
+20 ;
+21 IF $Y>50
DO FOOTER
WRITE @IOF
DO RHEAD
+22 QUIT
RHEAD WRITE "AZ HEALTH DEPARTMENT REPORT",?51,"Phoenix Indian Medical Center",!,?46,"4212 N. 16th St., Phoenix, AZ 85016",!,"From "_PEDT_" to "_PSDT,?53,"****** CONFIDENTIAL ******",?98,"Printed: "_...
... $EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),?120,"Page: "_PG,!
+1 WRITE !,"Name",?30,"ID#",?40,"DOB",?54,"Sex",?58,"Lab #",?70,"Sample",?84,"Col Dt",?94,"Cpl Dt",?106,"Provider",!,?5,"Phone #",?30,"Address",?106,"Location"
+2 ;
+3 ; start - vjm 5/15/2000
+4 ;Modified to print current community on all reports
+5 ;IHS/PIMC/JLG 12/6/00
WRITE !?5,"Current Community"
+6 ; end - vjm
+7 ;
+8 WRITE !
FOR LI=0:1:IOM-1
WRITE ?LI,"-"
+9 WRITE !
SET PG=PG+1
SET FOOTFLG=1
+10 WRITE !,"Reporting Organism: "_DWBUG,!
+11 QUIT
FOR PP=1:1:PLG
WRITE !
+1 WRITE "________________________________________ _______________"
+2 WRITE !," Medical Technologist Date"
+3 QUIT
+4 ;
+5 ;====================================================================
INTROTXT ; introduction text of this Local Health Department [Gila River] report
+1 ;
+2 WRITE !!!
+3 WRITE "This report prints Arizona Health Department organisms which have",!
+4 WRITE "been identified during the date interval selected. The report",!
+5 WRITE "is for patients residing only in selected Gila River communities.",!!
+6 WRITE "NOTE: This report requires a COMPRESSED (132 characters/line) printer!",!!
+7 KILL DIRUT
+8 SET DIR(0)="E"
SET DIR("A")="Press <Return> to continue or '^' to quit"
+9 DO ^DIR
KILL DIR,DA
+10 IF $DATA(DIRUT)
SET BZX("QUIT")=1
+11 IF $DATA(BZX("QUIT"))
QUIT
+12 IF $DATA(IOF)
WRITE @IOF
+13 QUIT
+14 ;
+15 ;
BZXGR ; processing for Gila River Community pts
+1 ; ^BZXGRHD --> BZX DWMIHDR1 GILA RIVER HLTH RPT COMMUNITIES file
+2 ;
+3 SET BZX("COMM IEN")=0
+4 SET BZX("COMM IEN")=$$COMMRES^AUPNPAT(DFN,"I")
+5 ;
+6 ; do this IF the ptr value for CURRENT COMMUNITY does not exist
+7 IF '+BZX("COMM IEN")
Begin DoDot:1
+8 SET BZX("COMM NAME")=$PIECE(^AUPNPAT(DFN,11),U,18)
+9 SET BZX("COMM IEN")=$ORDER(^AUTTCOM("B",BZX("COMM NAME"),0))
+10 QUIT
End DoDot:1
+11 ;
+12 ; get IEN of the local BZX gila river community list
+13 SET BZX("IEN")=$ORDER(^BZXGRHR("B",BZX("COMM IEN"),0))
+14 ;
+15 ; QUIT if no entry in local file
IF '+BZX("IEN")
DO BZXKVARS
QUIT
+16 SET BZXCOMM=$$COMMRES^AUPNPAT(DFN,"E")
+17 DO BZXKVARS
+18 QUIT
BZXKVARS ; clean up the BZX vars
+1 KILL BZX
+2 QUIT
+3 ; end of routine
