Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDCRL

BSDCRL.m

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