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

BSDHS.m

Go to the documentation of this file. 
  1. BSDHS ; IHS/ANMC/LJF - HS BY CLINIC ;  [ 08/20/2004  11:54 AM ]
  1.  ;;5.3;PIMS;**1001,1010**;APR 26, 2002
  1.  ;
  1.  ;cmi/anch/maw 10/20/2008 PATCH 1010 RQMT79 added the ability to select health summary
  1.  ;
  1.  ;
  1.  NEW BSDDT,VAUTD,VAUTC,BSDSRT
  1. DATE ; -- select date
  1.  S BSDDT=$$READ^BDGF("DO^::EX","Print Health Summaries for Which Date")
  1.  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 END Q
  1.  ;
  1. SORTS ; -- sort by
  1.  NEW DIR0,DIRA,DIRB
  1.  ;S DIR0="S^C:BY CLINIC CODE;P:BY PRINCIPAL CLINIC"
  1.  S DIR0="S^C:BY CLINIC NAME;P:BY PRINCIPAL CLINIC;T:BY TERMINAL DIGIT;N:BY PATIENT NAME"  ;IHS/ITSC/LJF 4/8/2004
  1.  S DIRA="HEALTH SUMMARIES SORT ORDER"
  1.  S BSDSRT=$$READ^BDGF(DIR0,DIRA,"P","^D HELP1^BSDHS")
  1.  ;I "CP"'[BSDSRT D END Q
  1.  I "CPTN"'[BSDSRT D END Q   ;IHS/ITSC/LJF 4/8/2004
  1.  ;
  1. OTHER ; -- print other forms too?
  1.  S BSDFORM=$$READ^BDGF("YO","Do you want to also print other forms","YES","^D HELP2^BSDHS")
  1.  I (BSDFORM="")!(BSDFORM=U) D END Q
  1.  ;
  1. DEVICE ; -- select print device
  1.  I VAUTD=1 S DIV=$$DIV^BSDU  ;user's division if all divisions selected
  1.  I VAUTD=0 S DIV=$O(VAUTD(0)) I 'DIV S DIV=$$DIV^BSDU  ;or first div
  1.  S DEFAULT=$$GET1^DIQ(9009020.2,DIV,.06)  ;default hs printer
  1.  S BSDHST=$$READ^BDGF("P^9001015:EMZ","Select Health Summary")  ;cmi/maw 10/20/2008 PATCH 1010 RQMT79 added call for user to select Heath Summary Type
  1.  D ZIS^BDGF("QP","START^BSDHS","HS BY CLINICS","BSDDT;BSDSRT;BSDHST;VAUTC*;VAUTD*;BSDFORM",DEFAULT)
  1.  ;
  1. END ; -- eoj
  1.  K ALL,DIV,ORD,ORDER,RMSEL,SDIQ,SDREP,SDSP,SDSTART
  1.  K SDX,X,Y,C,V,I,SDEF,%I Q
  1.  ;
  1. START ;EP; loop thru clinics and appts to get patients
  1.  ; build sorted array
  1.  U IO K ^TMP("BSDHS",$J)
  1.  S X=$S(VAUTC=1:"ALL",1:"SOME") D @X
  1.  ;
  1.  ; loop thru sorted array and call forms to print
  1.  NEW A,B,C,D S BSDLN=0
  1.  S A=0 F  S A=$O(^TMP("BSDHS",$J,A)) Q:A=""  D
  1.  . S B=0 F  S B=$O(^TMP("BSDHS",$J,A,B)) Q:B=""  D
  1.  .. S C=0 F  S C=$O(^TMP("BSDHS",$J,A,B,C)) Q:C=""  D
  1.  ... ;D FORMS(C,B)
  1.  ... ;D FORMS(B,C)   ;IHS/ITSC/LJF 1/2/2004
  1.  ... D FORMS(^TMP("BSDHS",$J,A,B,C),C)   ;IHS/ITSC/LJF 4/8/2004
  1.  ;
  1.  D ^%ZISC,END   ;IHS/ITSC/LJF 7/14/2004 PATCH #1001
  1.  K ^TMP("BSDHS",$J)
  1.  Q
  1.  ;
  1. ALL ; -- loop thru all clinics
  1.  NEW BSDCLN,BSDSUB
  1.  S BSDCLN=0 F  S BSDCLN=$O(^SC(BSDCLN)) Q:'BSDCLN  D
  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.  . F BSDSUB="S","C" D GETAPPT          ;get all appt & chart requests
  1.  Q
  1.  ;
  1. SOME ; -- loop thru selected clinics
  1.  NEW BSDCL,BSDCLN,BSDSUB
  1.  S BSDCL=0 F  S BSDCL=$O(VAUTC(BSDCL)) Q:BSDCL=""  D
  1.  . S BSDCLN=VAUTC(BSDCL)          ;clinic ien
  1.  . Q:'$$ACTV^BSDU(BSDCLN,BSDDT)   ;quit if inactive
  1.  . F BSDSUB="S","C" D GETAPPT     ;get all appt & chart requests
  1.  Q
  1.  ;
  1. GETAPPT ; -- for clinic, get appts & chart requests for date
  1.  NEW BSDT,BSDEND,BSDN,NODE,HRCN,TERM,SORT,LINE,X
  1.  S BSDT=BSDDT-.0001,BSDEND=BSDDT_".2400"
  1.  F  S BSDT=$O(^SC(BSDCLN,BSDSUB,BSDT)) Q:'BSDT  Q:(BSDT>BSDEND)  D
  1.  . S BSDN=0
  1.  . F  S BSDN=$O(^SC(BSDCLN,BSDSUB,BSDT,1,BSDN)) Q:'BSDN  D
  1.  .. S NODE=$G(^SC(BSDCLN,BSDSUB,BSDT,1,BSDN,0)) Q:'NODE
  1.  .. ;
  1.  .. ;
  1.  .. ; set sort values
  1.  .. ;IHS/ITSC/LJF 4/8/2004 rewrote this section of subroutine
  1.  .. S HRCN=$$HRCN^BDGF2(+NODE,$$FAC^BSDU(BSDCLN))  ;chart #
  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.  .. E  S TERM=$$HRCNT^BDGF2(HRCN)            ;terminal digit format
  1.  .. ;
  1.  .. I BSDSRT="C" S SORT=$$GET1^DIQ(44,BSDCLN,.01)     ;clinic name
  1.  .. I BSDSRT="P" S SORT=$$PRIN^BSDU(BSDCLN)        ;principal clinic
  1.  .. ;I SORT="UNAFFILIATED CLINICS" S SORT=$$GET1^DIQ(44,BSDCLN,.01)
  1.  .. I $G(SORT)="UNAFFILIATED CLINICS" S SORT=$$GET1^DIQ(44,BSDCLN,.01)  ;IHS/ITSC/LJF 4/21/2004
  1.  .. I BSDSRT="N" S SORT=$$GET1^DIQ(2,+NODE,.01)   ;sort by patient name
  1.  .. I BSDSRT="T" S SORT=TERM                     ;terminal digit sort
  1.  .. ;
  1.  .. ;S ^TMP("BSDHS",$J,SORT,TERM,+NODE)=""
  1.  .. S ^TMP("BSDHS",$J,SORT,TERM,+NODE)=BSDCLN  ;IHS/ITSC/LJF 4/16/2004
  1.  Q
  1.  ;
  1. FORMS(CLINIC,DFN) ; -- call forms code if turned on for clinic
  1.  NEW A,B,C   ;IHS/ITSC/LJF 1/2/2004
  1.  ; -- health summary first
  1.  I $$GET1^DIQ(9009017.2,CLINIC,.04)'="YES" Q
  1.  ;S X=$$GET1^DIQ(9009017.2,CLINIC,.05,"I")  ;hs type  cmi/maw 10/20/2008 orig line
  1.  ;D HS^BSDFORM(DFN,X)  ;cmi/maw 10/20/2008 orig line
  1.  D HS^BSDFORM(DFN,+BSDHST)  ;cmi/maw 10/20/2008 health summary is now BSDHST
  1.  ;
  1.  I BSDFORM=0 Q    ;quit if not printing other forms
  1.  ; -- rx profile
  1.  S BSDRX=$$GET1^DIQ(9009017.2,CLINIC,.06,"I")   ;rx profile flag
  1.  I BSDRX=1 D MP^BSDFORM(DFN)
  1.  I BSDRX=2 D APRO^BSDFORM(CLINIC,DFN,BSDDT)
  1.  ;
  1.  ; -- address/insurance update form
  1.  I $$VAL^XBDIQ1(9009017.2,CLINIC,.07)="YES" D AIU^BSDFORM(DFN)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. HELP1 ;EP; -- help for sort question
  1.  ;IHS/ITSC/LJF 4/8/2004 rewrote subroutine to add terminal digit and patient sorts
  1.  D MSG^BDGF("Answer C to sort by clinic, P to sort by principal clinic,",2,0)
  1.  D MSG^BDGF("T to sort by terminal digit or chart # and N to sort by",1,0)
  1.  D MSG^BDGF("patient name.  Within clinic or principal clinic, the health",1,0)
  1.  D MSG^BDGF("summaries will be sorted by terminal digit or chart #",1,0)
  1.  D MSG^BDGF("depending on how your file room parameter is set.",1,1)
  1.  Q
  1.  ;
  1. HELP2 ;EP; -- help for other forms question
  1.  D MSG^BDGF("Answer YES to print not only Health Summaries but",2,0)
  1.  D MSG^BDGF("also Address/Insurance Updates, Medication Profiles",1,0)
  1.  D MSG^BDGF("or Action Profiles if turned on for clinics selected.",1,1)
  1.  D MSG^BDGF("Answer NO to print ONLY Health Summaries.",1,1)
  1.  Q