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

BSDAL2.m

Go to the documentation of this file. 
  1. BSDAL2 ; IHS/ANMC/LJF - IHS APPT LIST - CONTINUED ;  
  1.  ;;5.3;PIMS;**1004,1005,1007,1011,1012,1013**;DEC 01, 2006
  1.  ;IHS version of SDAL0
  1.  ;IHS/OIT/LJF 07/15/2005 PATCH 1004 used code for printable age, instead of just a number
  1.  ;IHS/OIT/LJF 05/03/2006 PATCH 1005 added parens around inurance coverage for readability
  1.  ;cmi/anch/maw 11/22/2006 PATCH 1007 added code in APPTLN for item 1007.03
  1.  ;cmi/flag/maw 11/6/2009 PATCH 1011 added code in CLINIC to print for multiple days
  1.  ;cmi/flag/maw 6/4/2010 PATCH 1012 added code to expand other info
  1.  ;ihs/cmi/maw 04/05/2011 PATCH 1013 RQMT152 added cell phone
  1.  ;
  1. START ;EP; called by list template INIT^BSDALL
  1.  NEW SC,BSDCN
  1.  S BSDCN=0
  1.  F  S BSDCN=$S(VAUTC:$O(^SC("B",BSDCN)),1:$O(VAUTC(BSDCN))) Q:BSDCN=""  D
  1.  . S SC=0
  1.  . F  S SC=$O(^SC("B",BSDCN,SC)) Q:'SC  D CLINIC
  1.  Q
  1.  ;
  1. CLINIC ; called for each clinic
  1.  NEW BSDACT,BSD,IEN,FIRST,LINE
  1.  ; check if clinic is active and not cancelled for date
  1.  ;cmi/flag/maw 11/6/2009 pims patch 1011
  1.  N BSDDA
  1.  S BSDDA=0 F  S BSDDA=$O(BSDD(BSDDA)) Q:'BSDDA  D
  1.  . S BSDD=+$G(BSDD(BSDDA))
  1.  . I $$CHECK(SC,BSDD),$$ACTIVITY(SC,BSDD) D
  1.  .. S LINE=$S($G(BSDPRT):"@@@@@",1:"")      ;tof marker for paper print
  1.  .. S LINE=LINE_"Appointments for  "_$$GET1^DIQ(44,SC,.01)
  1.  .. S LINE=LINE_" clinic on  "_$$FMTE^XLFDT(BSDD)
  1.  .. D SET(LINE,.VALMCNT)
  1.  .. I '$G(BSDPRT) D SET($$REPEAT^XLFSTR("=",80),.VALMCNT)
  1.  .. ;
  1.  .. ;get each appt time for date and clinic
  1.  .. S BSDACT=0,BSD=BSDD
  1.  .. F  S BSD=$O(^SC(SC,"S",BSD)) Q:'BSD!(BSD\1>BSDD)  D
  1.  ... ;  find each appt at date/time then call APPTLN to print info
  1.  ... S IEN=0,FIRST=1
  1.  ... F  S IEN=$O(^SC(SC,"S",BSD,1,IEN)) Q:'IEN  D
  1.  .... Q:$P($G(^SC(SC,"S",BSD,1,IEN,0)),U,9)="C"     ;cancelled
  1.  .... D APPTLN(SC,BSD,IEN)                          ;print appt data line
  1.  .. ;
  1.  .. I 'BSDACT D
  1.  ... S BSDACT="No appointment activity found for this clinic date!"
  1.  ... D SET("",.VALMCNT),SET($$SP(75-$L(BSDACT)\2)_BSDACT,.VALMCNT)
  1.  .. ;
  1.  .. D SET("",.VALMCNT)         ;blank line before chart requests or next clinic
  1.  .. I BSDCR D CCLK(SC,BSDD)    ;print chart requests at end of list
  1.  ;
  1.  Q
  1.  ;
  1. APPTLN(CLN,DATE,IEN) ; -- for each individual appt, print patient data
  1.  NEW NODE,DFN,DATA,X,VA,VADM,BSDZ,SPACE,Z,VAPA,LINE
  1.  S NODE=^SC(CLN,"S",DATE,1,IEN,0),DFN=+NODE
  1.  ;cmi/anch/maw 11/3/2006 added length of appointment item 1007.03 patch 1007
  1.  N BSDLOA
  1.  S BSDLOA=$P(NODE,U,2)
  1.  ;cmi/anch/maw 11/3/2006 end of length of appointment item 1007.03 patch 1007
  1.  I BSDWI=0,$$WALKIN^BSDU2(DFN,DATE) Q                 ;quit if excluding walk-ins
  1.  S DATA=$G(^DPT(DFN,"S",DATE,0)) Q:$P(DATA,U,2)["C"   ;cancelled
  1.  D DEM^VADPT
  1.  ;
  1.  ; -- build display line
  1.  ; line 1: appt time, walkin, checkin, out vs inpt
  1.  I FIRST D                                       ;if first appt at this time, print time
  1.  . ;S FIRST=0,X=DATE D TM^SDROUT0 S LINE=$J(X,8)  ;cmi/anch/maw 11/3/2006 original line item 1007.03 patch 1007
  1.  . S FIRST=0,X=DATE D TM^SDROUT0 S LINE=$J(X,8)_$$SP(1)_$S($G(BSDLOA):"("_BSDLOA_" Min)",1:"")  ;cmi/anch/maw 11/3/2006 modified line item 1007.03 patch 1007
  1.  E  D SET("",.VALMCNT) S LINE=""                 ;else print extra line
  1.  ;
  1.  ;S LINE=$$PAD(LINE,12)  ;cmi/anch/maw 11/3/2006 original line item 1007.03 patch 1007
  1.  S LINE=$$PAD(LINE,20)  ;cmi/anch/maw 11/3/2006 modified line item 1007.03 patch 1007
  1.  I $P(DATA,U,7)=4 S LINE=LINE_"Walk-in "
  1.  E  S X=$P($G(^SC(SC,"S",DATE,1,IEN,"C")),U) I X]"" D
  1.  . D TM^SDROUT0 S LINE=LINE_"Checked in at "_X                  ;checkin time
  1.  ;
  1.  I ($P(DATA,U,2)="N")!($P(DATA,U,2)="NA") S LINE=LINE_"No-Show"
  1.  ;
  1.  S X=$$INPT1^BDGF1(DFN,DATE) S LINE=$$PAD(LINE,40)              ;inpatient?
  1.  I X]"" S LINE=LINE_"Admitted "_X_"  "                          ;admit date
  1.  S LINE=LINE_"("_$S($G(^DPT(DFN,.1))]"":^(.1),1:"Outpatient")_")"
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; -- line 2: name, chart #, dob, age, lab/x-ray/ekg times
  1.  I $$DEAD^BDGF2(DFN) D
  1.  . D SET($$SP(12)_"**PATIENT DIED ON "_$$DOD^BDGF2(DFN)_"**",.VALMCNT)
  1.  ;
  1.  S LINE=$$SP(3)_$S($D(^SC(SC,"S",DATE,1,IEN,"OB")):"*",1:"")    ;overbook
  1.  S LINE=$$PAD(LINE,5)_$E(VADM(1),1,20)                          ;pat name
  1.  S LINE=$$PAD($$PAD(LINE,27)_"#"_$$HRCN^BDGF2(DFN,DUZ(2)),36)   ;pat id
  1.  ;S LINE=LINE_$$FMTE^XLFDT(+VADM(3),5)_" ("_VADM(4)_")"         ;dob(age)
  1.  S LINE=LINE_$$FMTE^XLFDT(+VADM(3),5)_" ("_$$AGE(DFN)_")"       ;IHS/OIT/LJF 7/15/2005 PATCH 1004
  1.  ;
  1.  S (BSDZ(3),BSDZ(4),BSDZ(5))="",SPACE=0                         ;lab/xray/ekg
  1.  F X=3,4,5 S BSDZ(X)=$P(DATA,U,X)                               ;test date/times
  1.  ;F Z=3,4,5 S X=BSDZ(Z) D:X]"" TM^SDROUT0 S SPACE=Z#3*8+3 S LINE=$$PAD(LINE,(48+SPACE))_$J(X,8)_"  "
  1.  F Z=3,4,5 S X=BSDZ(Z) D:X]"" TM^SDROUT0 S SPACE=Z#3*8+3 S LINE=$$PAD(LINE,(50+SPACE))_$J(X,8)_"  "  ;IHS/OIT/LJF 7/15/2005 PATCH 1004
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; line 3: insurance coverage and other info
  1.  ;S LINE=$$PAD($$SP(9)_$$INSUR^BDGF2(DFN,DATE),18)_$P(NODE,U,4)
  1.  ;S LINE=$$PAD($$SP(9)_"("_$$INSUR^BDGF2(DFN,DATE)_")",18)_$P(NODE,U,4)   ;IHS/OIT/LJF 05/03/2006 PATCH 1005 cmi/maw PATCH 1012 RQMT129 orig line
  1.  S LINE=$$PAD($$SP(9)_"("_$$INSUR^BDGF2(DFN,DATE)_")",18)  ;IHS/OIT/LJF 05/03/2006 PATCH 1005 cmi/maw PATCH 1012 RQMT129 new line
  1.  D SET(LINE,.VALMCNT)
  1.  ;cmi/maw 6/4/2010 PATCH 1012 RQMT 129
  1.  I $L($P(NODE,U,4))>78 D
  1.  . S LINE=$E($P(NODE,U,4),1,78)
  1.  . D SET(LINE,.VALMCNT)
  1.  . S LINE=$E($P(NODE,U,4),79,155)
  1.  . D SET(LINE,.VALMCNT)
  1.  I $L($P(NODE,U,4))<78 D
  1.  . S LINE=$P(NODE,U,4)
  1.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; line 4: appt made by
  1.  I BSDAMB D
  1.  . NEW X,Y,Z
  1.  . S X=$P(NODE,U,6),Y=$P(NODE,U,7) Q:X=""
  1.  . S LINE=$$SP(9)_"Made by "_$$GET1^DIQ(200,X,.01)_"  on "
  1.  . S LINE=LINE_$$FMTE^XLFDT(Y,"2")
  1.  . S Z=$$GET1^DIQ(200,X,.132) I Z]"" S LINE=LINE_" ("_Z_")"  ;usr phone
  1.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; line 5: patient phone & primary care provider info
  1.  I (BSDPH)!(BSDPCMM) S LINE=$$SP(9) D
  1.  . ;cmi/anch/maw 11/3/2006 start of work phone print item 1007.01 patch 1007
  1.  . I BSDPH D
  1.  .. K VAPA
  1.  .. D ADD^VADPT
  1.  .. N BSDWPH,BSDCPH  ;ihs/cmi/maw 04/05/2011 Patch 1013 RQMT152
  1.  .. S BSDWPH=$$GET1^DIQ(2,DFN,.132)
  1.  .. S BSDCPH=$$GET1^DIQ(9000001,DFN,1801)  ;ihs/cmi/maw 04/05/2011 Patch 1013 RQMT152
  1.  .. S LINE=LINE_"Home Phone: "_VAPA(8)
  1.  .. S LINE=LINE_$$SP(3)_"Work Phone: "_$G(BSDWPH)
  1.  .. I $L(LINE>9) D SET(LINE,.VALMCNT)
  1.  .. S LINE=$$SP(8)_"Other Phone: "_$G(BSDCPH)  ;ihs/cmi/maw 04/05/2011 Patch 1013 RQMT152
  1.  .. D SET(LINE,.VALMCNT)
  1.  . ;cmi/anch/maw 11/3/2006 commented out line below to add work phone as well item 1007.01 patch 1007
  1.  . ;I BSDPH K VAPA D ADD^VADPT S LINE=LINE_"Phone: "_VAPA(8)  ;pat phone
  1.  . ;cmi/anch/maw 11/3/2006 end of work phone print item 1007.01 patch 1007
  1.  . I BSDPCMM D
  1.  .. NEW BSDARR S BSDARR="BSDARR" D PCP^BSDU1(DFN,.BSDARR)
  1.  .. ;I $D(BSDARR(1)) S LINE=$$PAD(LINE,60)_"PCP: "_$P(BSDARR(1),"/",1,2)  cmi/anch/maw 11/3/2006 original line item 1007.01 patch 1007
  1.  .. I $D(BSDARR(1)) S LINE=$$SP(9)_"PCP: "_$P(BSDARR(1),"/",1,2)  ;cmi/anch/maw 11/3/2006 modified line item 1007.01 patch 1007
  1.  .. I $L(LINE>9) D SET(LINE,.VALMCNT)  ;cmi/anch/maw 8/14/2007 added .notation as it was wrong PATCH 1007
  1.  ;
  1.  ;cmi/anch/maw 11/3/2006 added current community item 1007.02 patch 1007
  1.  ; line 6: current community
  1.  I $G(BSDCC) D
  1.  . S LINE=$$SP(9)_$S($$GET1^DIQ(9000001,DFN,1118)]"":"Current Community: "_$$GET1^DIQ(9000001,DFN,1118),1:"")
  1.  . D SET(LINE,.VALMCNT)
  1.  ;cmi/anch/maw 11/3/2006 end of item 1007.02 patch 1007
  1.  ;
  1.  S BSDACT=BSDACT+1 D SET("",.VALMCNT)
  1.  Q
  1.  ;
  1.  ;
  1. CCLK(CLN,DATE) ; -- list chart requests for this clinic and date
  1.  NEW BSDC,DFN,IEN,BSDN
  1.  I $O(^SC(CLN,"C",DATE,1,0)) D
  1.  . D SET("CHART REQUESTS for "_$$FMTE^XLFDT(DATE)_":",.VALMCNT)
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^SC(CLN,"C",DATE,1,IEN)) Q:'IEN  D
  1.  . S DFN=$G(^SC(CLN,"C",DATE,1,IEN,0)) Q:'DFN
  1.  . S BSDN=$G(^SC(CLN,"C",DATE,1,IEN,9999999))
  1.  . S LINE=$E($$GET1^DIQ(2,DFN,.01),1,20)
  1.  . S LINE=$$PAD(LINE,23)_"#"_$$HRCN^BDGF2(DFN,DUZ(2))
  1.  . S LINE=$$PAD(LINE,35)_$E($P(BSDN,U,3),1,33)
  1.  . D SET(LINE,.VALMCNT)
  1.  . I BSDAMB D
  1.  .. S LINE=$$SP(11)_"Made by "_$$GET1^DIQ(200,+$P(BSDN,U,2),.01)
  1.  .. S LINE=LINE_" on "_$$FMTE^XLFDT(+BSDN,"D")
  1.  .. S X=$$GET1^DIQ(200,+$P(BSDN,U,2),.132)
  1.  .. I X]"" S LINE=LINE_" ("_X_")"     ;user phone
  1.  .. D SET(LINE,.VALMCNT)
  1.  Q
  1.  ;
  1.  ;
  1. CHECK(CLN,APDT) ;check if clinic for this division and not cancelled or inactive
  1.  I $$GET1^DIQ(44,CLN,2,"I")'="C" Q 0                   ;not a clinic
  1.  I 'VAUTD,'$D(VAUTD(+$$GET1^DIQ(44,CLN,3.5,"I"))) Q 0  ;wrong division
  1.  I '$$ACTV^BSDU(CLN,APDT) Q 0                          ;not active
  1.  I $G(^SC(CLN,"ST",APDT,1))["**CANCELLED" Q 0          ;cancelled
  1.  Q 1
  1.  ;
  1.  ;
  1. ACTIVITY(CLN,APDT) ;Determine if clinic has activity to print for appt date
  1.  I BSDCR,$O(^SC(CLN,"C",APDT,0)) Q 1  ;chart request list
  1.  NEW DATE,FOUND,N
  1.  S FOUND=0,DATE=APDT
  1.  F  S DATE=$O(^SC(CLN,"S",DATE)) Q:'DATE  Q:(DATE\1>APDT)  Q:FOUND  D
  1.  .S N=0 F  S N=$O(^SC(CLN,"S",DATE,1,N)) Q:'N!FOUND  D
  1.  .. I $P(^SC(CLN,"S",DATE,1,N,0),U,9)'["C" S FOUND=1
  1.  Q FOUND
  1.  ;
  1. SET(DATA,NUM) ; put display line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDAL",$J,NUM,0)=DATA
  1.  Q
  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)
  1.  ;
  1. AGE(P) ; returns shortened printable age  ;IHS/OIT/LJF 7/15/2005 PATCH 1004
  1.  Q $E($$STRIP^XLFSTR($$AGE^AUPNPAT(DFN,DATE,"R")," "),1,3)