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

AMHGRAP.m

Go to the documentation of this file. 
  1. AMHGRAP ; IHS/CMI/MAW - AMHG Intake Form Data - frmIntake 9/16/2009 10:57:49 AM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
  1.  ;
  1.  ;
  1.  ;
  1. INIT(DFN,AMHBD,AMHED) ;EP -- init variables and list array
  1.  ; variables set are DFN, AMHBD, AMHED
  1.  ; AMHLN keeps track of line #s to update VALMCNT which is returned
  1.  ; AMHNUM used to link display line with entry
  1.  NEW APDT,NODE,LINE,END,AMHNUM,AMHLN,X,AMHM,AMHU
  1.  K ^TMP("AMHDPA",$J)
  1.  ;
  1.  ; loop thru pat's appts in date range
  1.  S HDR=$$SP(4)_"Appt Date/Time"_$$SP(6)_"Clinic Name"_$$SP(14)_"Type - Status"
  1.  D SET(HDR,"",1,.AMHLN)
  1.  S APDT=AMHBD,END=AMHED+.2400
  1.  F  S APDT=$O(^DPT(DFN,"S",APDT)) Q:'APDT!(APDT>END)  D
  1.  . S NODE=^DPT(DFN,"S",APDT,0)
  1.  . S LINE=$$PAD($$FMTE^XLFDT(APDT),20)                   ;appt dt
  1.  . S LINE=LINE_$$PAD($$GET1^DIQ(44,+NODE,.01),24)_" "    ;clinic
  1.  . S LINE=LINE_$$STATUS(DFN,APDT,NODE)                   ;type/status
  1.  . S AMHNUM=$G(AMHNUM)+1,LINE=$J(AMHNUM,2)_". "_LINE     ;add number
  1.  . S X=DFN_U_+NODE_U_APDT D SET(LINE,X,AMHNUM,.AMHLN)    ;set line
  1.  . D SET($$OI(DFN,+NODE,APDT),"",AMHNUM,.AMHLN)          ;other info
  1.  . I $P(NODE,U,2)["C",$G(^DPT(DFN,"S",APDT,"R"))]"" D
  1.  .. D SET($$SP(15)_"Cancel Remark: "_^DPT(DFN,"S",APDT,"R"),"",AMHNUM,.AMHLN)  ;cncl rmark
  1.  . D SET(" ","",AMHNUM,.AMHLN)                           ;blank line
  1.  ;
  1.  ;IHS/OIT/LJF 07/20/2005 PATCH 1004 added display of active waiting list entries for patient
  1.  K AMHWLR D WLDATA^BSDWLV(DFN,"C",.AMHWLR)
  1.  S:'$D(AMHNUM) AMHNUM=0 D SET(" ","",AMHNUM,.AMHLN)
  1.  ;
  1.  I '$O(AMHWLR(0)) D SET($$SP(10)_AMHWLR(0),"",AMHNUM,.AMHLN) I 1
  1.  E  D
  1.  . D SET($$SP(17)_"**** ACTIVE WAIT LIST ENTRIES FOR PATIENT ****","",AMHNUM,.AMHLN)
  1.  . D SET(AMHWLR(0),"",AMHNUM,.AMHLN)                   ;caption line
  1.  . D SET($$REPEAT^XLFSTR("-",77),"",AMHNUM,.AMHLN)     ;dividing line
  1.  . NEW DATE,LINE
  1.  . S DATE=0 F  S DATE=$O(AMHWLR(DATE)) Q:'DATE  D
  1.  . . S LINE=0 F  S LINE=$O(AMHWLR(DATE,LINE)) Q:'LINE  D
  1.  . . . D SET($S(LINE=1:"",1:$$SP(3))_$P(AMHWLR(DATE,LINE),U,2),"",AMHNUM,.AMHLN)
  1.  . D SET(" ","",AMHNUM,.AMHLN)    ;extra line for spacing
  1.  ;end of PATCH 1004 additions
  1.  ;
  1.  S VALMCNT=+$G(AMHLN)
  1.  Q
  1.  ;
  1. SET(LINE,DATA,NUM,AMHLN) ; -- set ^tmp with display line
  1.  S AMHLN=$G(AMHLN)+1
  1.  S ^TMP("AMHDPA",$J,AMHLN,0)=LINE
  1.  S ^TMP("AMHDPA",$J,"IDX",AMHLN,NUM)=DATA
  1.  Q
  1.  ;
  1. EXIT ;EP -- exit code
  1.  K AMHBD,AMHED,AMHLN,AMHNUM
  1.  K SDC,SDIFN,SDP,SDPP,SDS,SDSTAT,VALMY,ORX
  1.  K VALMBCK,VALMCNT,VALMHDR
  1.  D KILL^AUPNPAT
  1.  Q
  1.  ;
  1.  ;
  1. STATUS(PAT,DATE,NODE) ; returns appt status
  1.  NEW TYP
  1.  S TYP=$$APPTYP^BSDU2(PAT,DATE)    ;sched vs. walkin
  1.  I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
  1.  I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
  1.  I $$CO^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
  1.  I $$CI^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
  1.  Q TYP
  1.  ;
  1. OI(PAT,CLINIC,DATE) ; -- returns other info display line
  1.  Q $$SP(15)_$E($$OI^BSDU2(PAT,CLINIC,DATE),1,65)
  1.  ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)
  1.  ;
  1. RESVIEW() ; -- returns 1 if restrict viewing of who made appt turned on
  1.  Q +$$GET1^DIQ(9009020.2,$$DIV^BSDU,.12,"I")
  1.  ;
  1. GETVST(PAT,DATE) ; returns visit ien for appt date and patient
  1.  NEW X
  1.  I ('PAT)!('DATE) Q 0
  1.  S X=$G(^DPT(PAT,"S",DATE,0)) I 'X Q 0   ;appt node
  1.  S X=$P(X,U,20) I 'X Q 0                 ;outpt encounter ptr
  1.  S X=$G(^SCE(X,0)) I 'X Q 0              ;outpt encounter node
  1.  I $P(X,U,2)'=PAT Q 0                    ;patient ptr
  1.  Q $P(X,U,5)                             ;visit ptr
  1.  ;