BZXLRSEP ;IHS/PIMC/JLG - AZ HEALTH DEPT REPORT [ 08/13/2002 3:03 PM ]
;;1.0;Special local routine for printing reportable disesases
;Original WRITTEN BY DAN WALZ CALLED BY DWLRSER1
PREPORT I '$D(^TMP($J)) W @IOF,"NO DATA TO REPORT" Q
S PEDT=$E(BZXENDT,4,5)_"/"_$E(BZXENDT,6,7)_"/"_$E(BZXENDT,2,3)
S PSDT=$E(BZXSDT,4,5)_"/"_$E(BZXSDT,6,7)_"/"_$E(BZXSDT,2,3)
S FOOTFLG=0,PG=1
S BZXTP=0
F S BZXTP=$O(^TMP($J,BZXTP)) Q:'BZXTP D
.S IENS=BZXTP_","
.S BZXTST=$$GET1^DIQ(1966360,IENS,2)
.I FOOTFLG=1 D FOOTER
.W @IOF
.D RHEAD
.S LRDFN=""
.F S LRDFN=$O(^TMP($J,BZXTP,LRDFN)) Q:'LRDFN D
..S LRIDT=""
..F S LRIDT=$O(^TMP($J,BZXTP,LRDFN,LRIDT)) Q:'LRIDT D PRTIT
D FOOTER W @IOF
Q
;
RLOOP1 D:FOOTFLG=1 FOOTER
W @IOF D RHEAD W !,"Reporting Test: "_DWBUG,!
S RPNM="" F II=0:0 S RPNM=$O(^UTILITY("CH",$J,DWBUG,RPNM)) Q:RPNM="" D RLOOP2
Q
RLOOP2 S RACC="" F III=0:0 S RACC=$O(^UTILITY("CH",$J,DWBUG,RPNM,RACC)) Q:RACC="" D PRTIT
Q
;
PRTIT ; Print
S Y=^TMP($J,BZXTP,LRDFN,LRIDT)
S Y1=^LR(LRDFN,"CH",LRIDT,0)
W !!,$E($P(Y,U,1),1,28) ;PATIENT NAME
W ?30,$P(Y,U,2) ;HRN
W ?40,$P(Y,U,3) ;DOB
W ?54,$E($P(Y,U,4),1,1) ;SEX
W ?58,$P(Y1,U,6) ;ACCN
S IENS=LRIDT_","_LRDFN_","
S SPEC=$$GET1^DIQ(63.04,IENS,.05)
W ?74,$E(SPEC,1,12) ;SPEC
S COLDT=$P(Y1,U,1)
W ?88,$E(COLDT,4,5)_"/"_$E(COLDT,6,7)_"/"_$E(COLDT,2,3) ;COL DT
S VERDT=$P(Y1,U,3)
W ?98,$E(VERDT,4,5)_"/"_$E(VERDT,6,7)_"/"_$E(VERDT,2,3) ;verify or complete date
S PROV=$$GET1^DIQ(63.04,IENS,.1)
W ?108,$E(PROV,1,23) ;PROV
W !,?5,$P(Y,U,5) ;PHONE
W ?30,$P(Y,U,6) ;STREET
W ?64,$P(Y,U,7) ;CITY
W ?84,$P(Y,U,8) ;STATE
W ?98,$P(Y,U,9) ;ZIP
W ?108,$E($P(Y1,U,11),1,23) ;LOC
W !,?5,"Result: ",$P(Y,U,11)
;
; start - vjm 4/14/2000
;W !?5,"Current COMMUNITY: ",$G(BZXXCOMM)
W !?5,"Current COMMUNITY: "
W $P(Y,U,10) ;CURRENT COMMUNITY
; end - vjm 4/14/2000
;
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 "_PSDT_" to "_PEDT,?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 #",?74,"Sample",?88,"Col Dt",?98,"Cpl Dt",?108,"Provider",!,?5,"Phone #",?30,"Address",?108,"Location"
;
; start - vjm 4/14/2000
W:$G(BZXGR) !?5,"Current Community"
; end - vjm 4/14/2000
;
S M=$S($G(IOM):IOM,1:132)
W ! F LI=0:1:M-1 W ?LI,"-"
W ! S PG=PG+1,FOOTFLG=1
W !,"Reporting Test: "_BZXTST
Q
;
W "________________________________________ _______________"
W !," Medical Technologist Date"
Q
BZXLRSEP ;IHS/PIMC/JLG - AZ HEALTH DEPT REPORT [ 08/13/2002 3:03 PM ]
+1 ;;1.0;Special local routine for printing reportable disesases
+2 ;Original WRITTEN BY DAN WALZ CALLED BY DWLRSER1
PREPORT IF '$DATA(^TMP($JOB))
WRITE @IOF,"NO DATA TO REPORT"
QUIT
+1 SET PEDT=$EXTRACT(BZXENDT,4,5)_"/"_$EXTRACT(BZXENDT,6,7)_"/"_$EXTRACT(BZXENDT,2,3)
+2 SET PSDT=$EXTRACT(BZXSDT,4,5)_"/"_$EXTRACT(BZXSDT,6,7)_"/"_$EXTRACT(BZXSDT,2,3)
+3 SET FOOTFLG=0
SET PG=1
+4 SET BZXTP=0
+5 FOR
SET BZXTP=$ORDER(^TMP($JOB,BZXTP))
IF 'BZXTP
QUIT
Begin DoDot:1
+6 SET IENS=BZXTP_","
+7 SET BZXTST=$$GET1^DIQ(1966360,IENS,2)
+8 IF FOOTFLG=1
DO FOOTER
+9 WRITE @IOF
+10 DO RHEAD
+11 SET LRDFN=""
+12 FOR
SET LRDFN=$ORDER(^TMP($JOB,BZXTP,LRDFN))
IF 'LRDFN
QUIT
Begin DoDot:2
+13 SET LRIDT=""
+14 FOR
SET LRIDT=$ORDER(^TMP($JOB,BZXTP,LRDFN,LRIDT))
IF 'LRIDT
QUIT
DO PRTIT
End DoDot:2
End DoDot:1
+15 DO FOOTER
WRITE @IOF
+16 QUIT
+17 ;
RLOOP1 IF FOOTFLG=1
DO FOOTER
+1 WRITE @IOF
DO RHEAD
WRITE !,"Reporting Test: "_DWBUG,!
+2 SET RPNM=""
FOR II=0:0
SET RPNM=$ORDER(^UTILITY("CH",$JOB,DWBUG,RPNM))
IF RPNM=""
QUIT
DO RLOOP2
+3 QUIT
RLOOP2 SET RACC=""
FOR III=0:0
SET RACC=$ORDER(^UTILITY("CH",$JOB,DWBUG,RPNM,RACC))
IF RACC=""
QUIT
DO PRTIT
+1 QUIT
+2 ;
PRTIT ; Print
+1 SET Y=^TMP($JOB,BZXTP,LRDFN,LRIDT)
+2 SET Y1=^LR(LRDFN,"CH",LRIDT,0)
+3 ;PATIENT NAME
WRITE !!,$EXTRACT($PIECE(Y,U,1),1,28)
+4 ;HRN
WRITE ?30,$PIECE(Y,U,2)
+5 ;DOB
WRITE ?40,$PIECE(Y,U,3)
+6 ;SEX
WRITE ?54,$EXTRACT($PIECE(Y,U,4),1,1)
+7 ;ACCN
WRITE ?58,$PIECE(Y1,U,6)
+8 SET IENS=LRIDT_","_LRDFN_","
+9 SET SPEC=$$GET1^DIQ(63.04,IENS,.05)
+10 ;SPEC
WRITE ?74,$EXTRACT(SPEC,1,12)
+11 SET COLDT=$PIECE(Y1,U,1)
+12 ;COL DT
WRITE ?88,$EXTRACT(COLDT,4,5)_"/"_$EXTRACT(COLDT,6,7)_"/"_$EXTRACT(COLDT,2,3)
+13 SET VERDT=$PIECE(Y1,U,3)
+14 ;verify or complete date
WRITE ?98,$EXTRACT(VERDT,4,5)_"/"_$EXTRACT(VERDT,6,7)_"/"_$EXTRACT(VERDT,2,3)
+15 SET PROV=$$GET1^DIQ(63.04,IENS,.1)
+16 ;PROV
WRITE ?108,$EXTRACT(PROV,1,23)
+17 ;PHONE
WRITE !,?5,$PIECE(Y,U,5)
+18 ;STREET
WRITE ?30,$PIECE(Y,U,6)
+19 ;CITY
WRITE ?64,$PIECE(Y,U,7)
+20 ;STATE
WRITE ?84,$PIECE(Y,U,8)
+21 ;ZIP
WRITE ?98,$PIECE(Y,U,9)
+22 ;LOC
WRITE ?108,$EXTRACT($PIECE(Y1,U,11),1,23)
+23 WRITE !,?5,"Result: ",$PIECE(Y,U,11)
+24 ;
+25 ; start - vjm 4/14/2000
+26 ;W !?5,"Current COMMUNITY: ",$G(BZXXCOMM)
+27 WRITE !?5,"Current COMMUNITY: "
+28 ;CURRENT COMMUNITY
WRITE $PIECE(Y,U,10)
+29 ; end - vjm 4/14/2000
+30 ;
+31 IF $Y>50
DO FOOTER
WRITE @IOF
DO RHEAD
+32 QUIT
+33 ;
RHEAD WRITE "AZ HEALTH DEPARTMENT REPORT",?51,"Phoenix Indian Medical Center",!,?46,"4212 N. 16th St., Phoenix, AZ 85016",!,"From "_PSDT_" to "_PEDT,?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 #",?74,"Sample",?88,"Col Dt",?98,"Cpl Dt",?108,"Provider",!,?5,"Phone #",?30,"Address",?108,"Location"
+2 ;
+3 ; start - vjm 4/14/2000
+4 IF $GET(BZXGR)
WRITE !?5,"Current Community"
+5 ; end - vjm 4/14/2000
+6 ;
+7 SET M=$SELECT($GET(IOM):IOM,1:132)
+8 WRITE !
FOR LI=0:1:M-1
WRITE ?LI,"-"
+9 WRITE !
SET PG=PG+1
SET FOOTFLG=1
+10 WRITE !,"Reporting Test: "_BZXTST
+11 QUIT
+12 ;
FOR PP=1:1:PLG
WRITE !
+1 WRITE "________________________________________ _______________"
+2 WRITE !," Medical Technologist Date"
+3 QUIT
