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

BDGSVS.m

Go to the documentation of this file. 
  1. BDGSVS ; IHS/ANMC/LJF - SCHED VISIT SUMMARY ; 
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1.  ; Assumes BDGN set to ien in Scheduled Visit file
  1.  I $$BROWSE^BDGF="B" D EN Q
  1.  D ZIS^BDGF("PQ","EN^BDGSVS","SCHED VISIT SUMMARY","BDGN") Q
  1.  ;
  1. EN ; -- main entry point for BDG SCHED VISIT SUMMARY
  1.  NEW VALMCNT
  1.  I $E(IOST,1,2)="P-" D INIT,PRINT Q
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG SCHED VISIT SUMMARY")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
  1.  S X=$E($$GET1^DIQ(9009016.7,BDGN,.01),1,25)               ;pat name
  1.  S X=$$PAD(X,30)_"#"_$$GET1^DIQ(9009016.7,BDGN,.011)       ;chart #
  1.  S X=$$PAD(X,40)_"Age: "_$$GET1^DIQ(9009016.7,BDGN,.012)   ;age
  1.  S X=$$PAD(X,50)_"Comm: "_$$GET1^DIQ(9009016.7,BDGN,.013)  ;community
  1.  S VALMHDR(2)=X
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW DFN,LINE,X
  1.  K ^TMP("BDGSVS",$J)
  1.  S VALMCNT=0
  1.  ;
  1.  S X="SCHEDULED "_$$GET1^DIQ(9009016.7,BDGN,.03)
  1.  S LINE=$$SP(79-$L(X)\2)_$G(IORVON)_X_$G(IORVOFF)     ;center visit type
  1.  D SET(LINE,.VALMCNT),SET("",.VALMCNT)
  1.  ;
  1.  ; set up display of fields based on visit type
  1.  S X=$$GET1^DIQ(9009016.7,BDGN,.03,"I") Q:X=""  D @X
  1.  D SET("",.VALMCNT)
  1.  D TRAVEL                     ;travel fields
  1.  D SET("",.VALMCNT)
  1.  D DATA(203,21)                  ;additional comments
  1.  ;
  1.  Q
  1.  ;
  1. A ; process admission fields
  1.  NEW FIELD
  1.  F FIELD=.02,.13,.04,.05,.08,.09,201,.06,.14,.15,202,.16 D DATA(FIELD,26)
  1.  Q
  1.  ;
  1. D ; process day surgery fields
  1.  NEW FIELD
  1.  F FIELD=.02,.14,.13,.17,.04,.05,.121,201,202,.06,.16 D DATA(FIELD,26)
  1.  Q
  1.  ;
  1. O ; process outpatient visit fields
  1.  NEW FIELD
  1.  F FIELD=.02,.13,.04,.05,.11,201,202,.06,.16 D DATA(FIELD,26)
  1.  Q
  1.  ;
  1. DATA(FLD,LEN) ; process one field
  1.  NEW X,LINE
  1.  S X=$$GET1^DIQ(9009016.7,BDGN,FLD) I X="" Q
  1.  D SET($$RJ^XLFSTR($$TITLE(FLD),LEN)_X,.VALMCNT)
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; put display data into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGSVS",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. TITLE(F) ;  return field F name or title
  1.  NEW X S X=$G(^DD(9009016.7,F,.1))
  1.  Q $S(X]"":X,1:$P(^DD(9009016.7,F,0),U))_":  "
  1.  ;
  1. TRAVEL ; set up travel fields for display
  1.  NEW FIELD
  1.  F FIELD=101,103,104,105,102 D DATA(FIELD,26)
  1.  D SET("",.VALMCNT)
  1.  F FIELD=106,107,108,109,110,111 D DATA(FIELD,34)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGSVS",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  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. PRINT ; print report to paper
  1.  NEW BDGX
  1.  U IO D HDR
  1.  ;
  1.  ; loop thru display array
  1.  S BDGX=0 F  S BDGX=$O(^TMP("BDGSVS",$J,BDGX)) Q:'BDGX  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BDGSVS",$J,BDGX,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  D HDR W @IOF,?15,"Scheduled Visit Summary"
  1.  F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;