BSDCRL ; IHS/ANMC/LJF - CHART REQUESTS LIST ; [ 08/20/2004 11:52 AM ]
;;5.3;PIMS;**1001**;APR 26, 2002
;
NEW BSDDT,VAUTD,VAUTC,BSDSRT
DATES ; -- select date
S BSDDT=$$READ^BDGF("DO^::EX","Select Date") Q:BSDDT<1
;
CLINIC ; -- all clinics or selected ones?
; if ALL clinics are selected, VAUTC=1
; otherwise the VAUTC array is set and VAUTC=0
D CLINIC^BSDU(1) I Y<0 D EXIT Q
;
SORTS ; -- sort by
NEW DIR0,DIRA,DIRB
S DIR0="S^D:BY DATE/TIME REQUESTED;C:BY CLINIC CODE;P:BY PRINCIPAL CLINIC;T:BY TERMINAL DIGIT"
S DIRA="CHARTS REQUESTED BY DATE SORT ORDER"
S BSDSRT=$$READ^BDGF(DIR0,DIRA,"D","^D HELP^BSDCRL")
I "CPTD"'[BSDSRT D EXIT Q
;
DEVICE ; -- select device
NEW DGVAR,PGM,POP
D MSG^BDGF("Use wide paper or condensed print if printing to paper",2,1)
S DGVAR="VAUTD#^VAUTC#^BSDSRT^BSDDT",PGM="START^BSDCRL"
D ZIS^DGUTQ I POP D EXIT Q
I '$D(IO("Q")) D START^BSDCRL
Q
;
;
START ;EP; entry to report after calling print device
I $E(IOST,1,2)="C-" D EN Q ;use listman if using screen
D GATHER,PRINT Q ;otherwise print to paper
;
EN ;EP; -- entry for list manager interface
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDRM CHART REQUEST LIST")
D CLEAR^VALM1
Q
;
HDR ;EP; -- report heading
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
S VALMHDR(2)=$$SP(25)_"CHART REQUESTS for "_$$FMTE^XLFDT(BSDDT)
Q
;
GATHER ;EP; -- gathers data and sets into display array
NEW BSDCNT,BSDNP
; build sorted array
K ^TMP("BSDCRL",$J),^TMP("BSDCRL1",$J)
S (BSDCNT,BSDNP)=0 ;count and # not printed
S X=$S(VAUTC=1:"ALL",1:"SOME") D @X
;
; reset sorted array into display array
NEW A,B,C,D S BSDLN=0
S A=0 F S A=$O(^TMP("BSDCRL1",$J,A)) Q:A="" D
. ; add sort subheading
. I BSDSRT'="T",BSDSRT'="D" D
.. D SET("",.BSDLN),SET($$SP(23)_"**"_A_"**",.BSDLN)
. ;
. S B=0 F S B=$O(^TMP("BSDCRL1",$J,A,B)) Q:B="" D
.. S C=0 F S C=$O(^TMP("BSDCRL1",$J,A,B,C)) Q:C="" D
... S D=0 F S D=$O(^TMP("BSDCRL1",$J,A,B,C,D)) Q:D="" D
.... D SET(^TMP("BSDCRL1",$J,A,B,C,D),.BSDLN)
;
I BSDCNT>0 D SET("Total Chart Requests: "_BSDCNT_"; Total Not Printed: "_BSDNP,.BSDLN)
;
S VALMCNT=BSDLN
I 'VALMCNT S VALMCNT=1,^TMP("BSDCRL",$J,1,0)=$$SP(10)_"** NO CHART REQUESTS FOUND FOR DATE **"
K ^TMP("BSDCRL1",$J)
Q
;
ALL ; -- loop thru all clinics
NEW BSDCLN
S BSDCLN=0 F S BSDCLN=$O(^SC(BSDCLN)) Q:'BSDCLN D
. I $$GET1^DIQ(44,BSDCLN,2,"I")'="C" Q ;not a clinic
. Q:'$$ACTV^BSDU(BSDCLN,BSDDT) ;quit if inactive
. I VAUTD=0 Q:'$D(VAUTD(+$$DIVC^BSDU(BSDCLN))) ;quit if not select div
. D GETCR ;get all chart requests
Q
;
SOME ; -- loop thru selected clinics
NEW BSDCL,BSDCLN
S BSDCL=0 F S BSDCL=$O(VAUTC(BSDCL)) Q:BSDCL="" D
. S BSDCLN=VAUTC(BSDCL) ;clinic ien
. I $$GET1^DIQ(44,BSDCLN,2,"I")'="C" Q ;not a clinic
. Q:'$$ACTV^BSDU(BSDCLN,BSDDT) ;quit if inactive
. D GETCR ;get all chart requests
Q
;
GETCR ; -- for clinic, get appts & chart requests for date
NEW BSDT,BSDEND,BSDN,PAT,HRCN,TERM,SORT,LINE,X,NODE
S BSDT=BSDDT-.0001,BSDEND=BSDDT_".2400"
F S BSDT=$O(^SC(BSDCLN,"C",BSDT)) Q:'BSDT Q:(BSDT>BSDEND) D
. S BSDN=0
. F S BSDN=$O(^SC(BSDCLN,"C",BSDT,1,BSDN)) Q:'BSDN D
.. S PAT=$G(^SC(BSDCLN,"C",BSDT,1,BSDN,0)) Q:'PAT
.. ;
.. ; set sort values
.. I BSDSRT="D" S SORT=+$G(^SC(BSDCLN,"C",BSDT,1,BSDN,9999999)) ;date
.. I BSDSRT="C" S SORT=$$CLNCODE^BSDU(BSDCLN) ;clinic code
.. I BSDSRT="P" S SORT=$$PRIN^BSDU(BSDCLN) ;principal clinic
.. S HRCN=$$HRCN^BDGF2(PAT,$$FAC^BSDU(BSDCLN)) ;chart #
.. S TERM=$$HRCNT^BDGF2(HRCN) ;terminal digit format
.. I $$GET1^DIQ(9009020.2,+$$DIVC^BSDU(BSDCLN),.18)="NO" D
... S TERM=$$HRCND^BDGF2(HRCN) ;no terminal digit per site param
.. I BSDSRT="T" S SORT=TERM ;terminal digit sort
.. ;
.. ; set display line
.. S NODE=$G(^SC(BSDCLN,"C",BSDT,1,BSDN,9999999))
.. S LINE=$J(HRCN,6)_" "_$E($$GET1^DIQ(2,PAT,.01),1,18) ;pat
.. S LINE=$$PAD(LINE,28)_$$GET1^DIQ(44,BSDCLN,1) ;cln abbrev
.. S LINE=$$PAD(LINE,37)_$E($$FMTE^XLFDT(+NODE),1,18) ;requested on
.. S LINE=$$PAD(LINE,57)_$$GET1^DIQ(200,+$P(NODE,U,2),1) ;requested by
.. S LINE=$$PAD(LINE,62)_$E($$FMTE^XLFDT($P(NODE,U,4)),1,18) ;printed
.. S LINE=$$PAD(LINE,82)_$P(NODE,U,3) ;deliver to
.. ;
.. S BSDCNT=BSDCNT+1 S:$P(NODE,U,4)="" BSDNP=BSDNP+1 ;counts
.. S ^TMP("BSDCRL1",$J,SORT,TERM,+PAT,BSDT)=LINE
;
Q
;
PRINT ; -- print to paper
;IHS/ITSC/WAR 7/30/04 PATCH #1001
;U IO D HDR NEW X
U IO D HEADING NEW BDGLN
;S X=0 F S X=$O(^TMP("BSDAPL",$J,X)) Q:'X D
S BDGLN=0 F S BDGLN=$O(^TMP("BSDCRL",$J,BDGLN)) Q:'BDGLN D
. I $Y>(IOSL-4) D HEADING
. ;W !,^TMP("BSDAPL",$J,X,0)
. W !,^TMP("BSDCRL",$J,BDGLN,0)
;PATCH #1001 END OF CHANGES
D ^%ZISC,EXIT
Q
;
HEADING ; -- heading for paper report
D HDR W @IOF,!,VALMHDR(1),!,VALMHDR(2)
W !,?55,"Printed on ",$$FMTE^XLFDT(DT),!,$$REPEAT^XLFSTR("=",79),!
Q
;
;
EXIT ;
K ^TMP("BSDCRL",$J) K BSDLN
Q
;
HELP1 ;
S X="?" D DISP^XQORM1 W !!
Q
;
;
SET(DATA,LINE) ; -- puts data into display array
S LINE=LINE+1
S ^TMP("BSDCRL",$J,LINE,0)=DATA
Q
;
HELP ;EP; -- help for SORTS question
D MSG^BDGF("Enter D to print by date/time teh chart qas requested.",2,1)
D MSG^BDGF("Enter C to print by Clinic Code then terminal digit.",2,1)
D MSG^BDGF("Enter P to print by Principal Clinic then terminal digit.")
D MSG^BDGF("Enter T to print by Terminal Digit order only",2,1)
D MSG^BDGF("If your file room does NOT sort by terminal digit",1,0)
D MSG^BDGF(" AND you set the site parameter that way,",1,0)
D MSG^BDGF(" then the report will use chart # order.",1,1)
Q
;
DOB(PAT) ; -- return date of birth in numerical format with leading zeros
NEW X S X=$$GET1^DIQ(2,PAT,.03,"I")
Q $S('X:"??",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3)))
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BSDCRL ; IHS/ANMC/LJF - CHART REQUESTS LIST ; [ 08/20/2004 11:52 AM ]
+1 ;;5.3;PIMS;**1001**;APR 26, 2002
+2 ;
+3 NEW BSDDT,VAUTD,VAUTC,BSDSRT
DATES ; -- select date
+1 SET BSDDT=$$READ^BDGF("DO^::EX","Select Date")
IF BSDDT<1
QUIT
+2 ;
CLINIC ; -- all clinics or selected ones?
+1 ; if ALL clinics are selected, VAUTC=1
+2 ; otherwise the VAUTC array is set and VAUTC=0
+3 DO CLINIC^BSDU(1)
IF Y<0
DO EXIT
QUIT
+4 ;
SORTS ; -- sort by
+1 NEW DIR0,DIRA,DIRB
+2 SET DIR0="S^D:BY DATE/TIME REQUESTED;C:BY CLINIC CODE;P:BY PRINCIPAL CLINIC;T:BY TERMINAL DIGIT"
+3 SET DIRA="CHARTS REQUESTED BY DATE SORT ORDER"
+4 SET BSDSRT=$$READ^BDGF(DIR0,DIRA,"D","^D HELP^BSDCRL")
+5 IF "CPTD"'[BSDSRT
DO EXIT
QUIT
+6 ;
DEVICE ; -- select device
+1 NEW DGVAR,PGM,POP
+2 DO MSG^BDGF("Use wide paper or condensed print if printing to paper",2,1)
+3 SET DGVAR="VAUTD#^VAUTC#^BSDSRT^BSDDT"
SET PGM="START^BSDCRL"
+4 DO ZIS^DGUTQ
IF POP
DO EXIT
QUIT
+5 IF '$DATA(IO("Q"))
DO START^BSDCRL
+6 QUIT
+7 ;
+8 ;
START ;EP; entry to report after calling print device
+1 ;use listman if using screen
IF $EXTRACT(IOST,1,2)="C-"
DO EN
QUIT
+2 ;otherwise print to paper
DO GATHER
DO PRINT
QUIT
+3 ;
EN ;EP; -- entry for list manager interface
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BSDRM CHART REQUEST LIST")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ;EP; -- report heading
+1 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+2 SET VALMHDR(2)=$$SP(25)_"CHART REQUESTS for "_$$FMTE^XLFDT(BSDDT)
+3 QUIT
+4 ;
GATHER ;EP; -- gathers data and sets into display array
+1 NEW BSDCNT,BSDNP
+2 ; build sorted array
+3 KILL ^TMP("BSDCRL",$JOB),^TMP("BSDCRL1",$JOB)
+4 ;count and # not printed
SET (BSDCNT,BSDNP)=0
+5 SET X=$SELECT(VAUTC=1:"ALL",1:"SOME")
DO @X
+6 ;
+7 ; reset sorted array into display array
+8 NEW A,B,C,D
SET BSDLN=0
+9 SET A=0
FOR
SET A=$ORDER(^TMP("BSDCRL1",$JOB,A))
IF A=""
QUIT
Begin DoDot:1
+10 ; add sort subheading
+11 IF BSDSRT'="T"
IF BSDSRT'="D"
Begin DoDot:2
+12 DO SET("",.BSDLN)
DO SET($$SP(23)_"**"_A_"**",.BSDLN)
End DoDot:2
+13 ;
+14 SET B=0
FOR
SET B=$ORDER(^TMP("BSDCRL1",$JOB,A,B))
IF B=""
QUIT
Begin DoDot:2
+15 SET C=0
FOR
SET C=$ORDER(^TMP("BSDCRL1",$JOB,A,B,C))
IF C=""
QUIT
Begin DoDot:3
+16 SET D=0
FOR
SET D=$ORDER(^TMP("BSDCRL1",$JOB,A,B,C,D))
IF D=""
QUIT
Begin DoDot:4
+17 DO SET(^TMP("BSDCRL1",$JOB,A,B,C,D),.BSDLN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 IF BSDCNT>0
DO SET("Total Chart Requests: "_BSDCNT_"; Total Not Printed: "_BSDNP,.BSDLN)
+20 ;
+21 SET VALMCNT=BSDLN
+22 IF 'VALMCNT
SET VALMCNT=1
SET ^TMP("BSDCRL",$JOB,1,0)=$$SP(10)_"** NO CHART REQUESTS FOUND FOR DATE **"
+23 KILL ^TMP("BSDCRL1",$JOB)
+24 QUIT
+25 ;
ALL ; -- loop thru all clinics
+1 NEW BSDCLN
+2 SET BSDCLN=0
FOR
SET BSDCLN=$ORDER(^SC(BSDCLN))
IF 'BSDCLN
QUIT
Begin DoDot:1
+3 ;not a clinic
IF $$GET1^DIQ(44,BSDCLN,2,"I")'="C"
QUIT
+4 ;quit if inactive
IF '$$ACTV^BSDU(BSDCLN,BSDDT)
QUIT
+5 ;quit if not select div
IF VAUTD=0
IF '$DATA(VAUTD(+$$DIVC^BSDU(BSDCLN)))
QUIT
+6 ;get all chart requests
DO GETCR
End DoDot:1
+7 QUIT
+8 ;
SOME ; -- loop thru selected clinics
+1 NEW BSDCL,BSDCLN
+2 SET BSDCL=0
FOR
SET BSDCL=$ORDER(VAUTC(BSDCL))
IF BSDCL=""
QUIT
Begin DoDot:1
+3 ;clinic ien
SET BSDCLN=VAUTC(BSDCL)
+4 ;not a clinic
IF $$GET1^DIQ(44,BSDCLN,2,"I")'="C"
QUIT
+5 ;quit if inactive
IF '$$ACTV^BSDU(BSDCLN,BSDDT)
QUIT
+6 ;get all chart requests
DO GETCR
End DoDot:1
+7 QUIT
+8 ;
GETCR ; -- for clinic, get appts & chart requests for date
+1 NEW BSDT,BSDEND,BSDN,PAT,HRCN,TERM,SORT,LINE,X,NODE
+2 SET BSDT=BSDDT-.0001
SET BSDEND=BSDDT_".2400"
+3 FOR
SET BSDT=$ORDER(^SC(BSDCLN,"C",BSDT))
IF 'BSDT
QUIT
IF (BSDT>BSDEND)
QUIT
Begin DoDot:1
+4 SET BSDN=0
+5 FOR
SET BSDN=$ORDER(^SC(BSDCLN,"C",BSDT,1,BSDN))
IF 'BSDN
QUIT
Begin DoDot:2
+6 SET PAT=$GET(^SC(BSDCLN,"C",BSDT,1,BSDN,0))
IF 'PAT
QUIT
+7 ;
+8 ; set sort values
+9 ;date
IF BSDSRT="D"
SET SORT=+$GET(^SC(BSDCLN,"C",BSDT,1,BSDN,9999999))
+10 ;clinic code
IF BSDSRT="C"
SET SORT=$$CLNCODE^BSDU(BSDCLN)
+11 ;principal clinic
IF BSDSRT="P"
SET SORT=$$PRIN^BSDU(BSDCLN)
+12 ;chart #
SET HRCN=$$HRCN^BDGF2(PAT,$$FAC^BSDU(BSDCLN))
+13 ;terminal digit format
SET TERM=$$HRCNT^BDGF2(HRCN)
+14 IF $$GET1^DIQ(9009020.2,+$$DIVC^BSDU(BSDCLN),.18)="NO"
Begin DoDot:3
+15 ;no terminal digit per site param
SET TERM=$$HRCND^BDGF2(HRCN)
End DoDot:3
+16 ;terminal digit sort
IF BSDSRT="T"
SET SORT=TERM
+17 ;
+18 ; set display line
+19 SET NODE=$GET(^SC(BSDCLN,"C",BSDT,1,BSDN,9999999))
+20 ;pat
SET LINE=$JUSTIFY(HRCN,6)_" "_$EXTRACT($$GET1^DIQ(2,PAT,.01),1,18)
+21 ;cln abbrev
SET LINE=$$PAD(LINE,28)_$$GET1^DIQ(44,BSDCLN,1)
+22 ;requested on
SET LINE=$$PAD(LINE,37)_$EXTRACT($$FMTE^XLFDT(+NODE),1,18)
+23 ;requested by
SET LINE=$$PAD(LINE,57)_$$GET1^DIQ(200,+$PIECE(NODE,U,2),1)
+24 ;printed
SET LINE=$$PAD(LINE,62)_$EXTRACT($$FMTE^XLFDT($PIECE(NODE,U,4)),1,18)
+25 ;deliver to
SET LINE=$$PAD(LINE,82)_$PIECE(NODE,U,3)
+26 ;
+27 ;counts
SET BSDCNT=BSDCNT+1
IF $PIECE(NODE,U,4)=""
SET BSDNP=BSDNP+1
+28 SET ^TMP("BSDCRL1",$JOB,SORT,TERM,+PAT,BSDT)=LINE
End DoDot:2
End DoDot:1
+29 ;
+30 QUIT
+31 ;
PRINT ; -- print to paper
+1 ;IHS/ITSC/WAR 7/30/04 PATCH #1001
+2 ;U IO D HDR NEW X
+3 USE IO
DO HEADING
NEW BDGLN
+4 ;S X=0 F S X=$O(^TMP("BSDAPL",$J,X)) Q:'X D
+5 SET BDGLN=0
FOR
SET BDGLN=$ORDER(^TMP("BSDCRL",$JOB,BDGLN))
IF 'BDGLN
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-4)
DO HEADING
+7 ;W !,^TMP("BSDAPL",$J,X,0)
+8 WRITE !,^TMP("BSDCRL",$JOB,BDGLN,0)
End DoDot:1
+9 ;PATCH #1001 END OF CHANGES
+10 DO ^%ZISC
DO EXIT
+11 QUIT
+12 ;
HEADING ; -- heading for paper report
+1 DO HDR
WRITE @IOF,!,VALMHDR(1),!,VALMHDR(2)
+2 WRITE !,?55,"Printed on ",$$FMTE^XLFDT(DT),!,$$REPEAT^XLFSTR("=",79),!
+3 QUIT
+4 ;
+5 ;
EXIT ;
+1 KILL ^TMP("BSDCRL",$JOB)
KILL BSDLN
+2 QUIT
+3 ;
HELP1 ;
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
+4 ;
SET(DATA,LINE) ; -- puts data into display array
+1 SET LINE=LINE+1
+2 SET ^TMP("BSDCRL",$JOB,LINE,0)=DATA
+3 QUIT
+4 ;
HELP ;EP; -- help for SORTS question
+1 DO MSG^BDGF("Enter D to print by date/time teh chart qas requested.",2,1)
+2 DO MSG^BDGF("Enter C to print by Clinic Code then terminal digit.",2,1)
+3 DO MSG^BDGF("Enter P to print by Principal Clinic then terminal digit.")
+4 DO MSG^BDGF("Enter T to print by Terminal Digit order only",2,1)
+5 DO MSG^BDGF("If your file room does NOT sort by terminal digit",1,0)
+6 DO MSG^BDGF(" AND you set the site parameter that way,",1,0)
+7 DO MSG^BDGF(" then the report will use chart # order.",1,1)
+8 QUIT
+9 ;
DOB(PAT) ; -- return date of birth in numerical format with leading zeros
+1 NEW X
SET X=$$GET1^DIQ(2,PAT,.03,"I")
+2 QUIT $SELECT('X:"??",1:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_(1700+$EXTRACT(X,1,3)))
+3 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
