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

BDGEAN.m

Go to the documentation of this file. 
  1. BDGEAN ; IHS/ANMC/LJF - INPTS W/ EXTERNAL ACCT # ; 
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1.  I $$BROWSE^BDGF="B" D EN Q
  1.  D ZIS^BDGF("PQ","EN^BDGEAN","INPT W/ ACCT #","")
  1.  Q
  1.  ;
  1. EN ; -- main entry point for BDG IPL W/ ACCT NO
  1.  I $E(IOST,1,2)="P-" D INIT,PRINT Q
  1.  NEW VALMCNT
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG IPL W/ ACCT NO")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW WARD,DFN,ADM,VST,LINE,COUNT,FIRST
  1.  S VALMCNT=0,(COUNT,FIRST)=1
  1.  K ^TMP("BDGEAN",$J)
  1.  ;
  1.  S WARD=0 F  S WARD=$O(^DPT("CN",WARD)) Q:WARD=""  D
  1.  . ;
  1.  . I 'FIRST D SET("",COUNT,"",.VALMCNT)
  1.  . I FIRST S FIRST=0
  1.  . D SET("WARD: "_WARD,COUNT,"",.VALMCNT)
  1.  . ;
  1.  . S DFN=0 F  S DFN=$O(^DPT("CN",WARD,DFN)) Q:'DFN  D
  1.  .. S ADM=$G(^DPT("CN",WARD,DFN)) Q:'ADM
  1.  .. S VST=+$$GET1^DIQ(405,ADM,.27,"I")
  1.  .. S LINE=$J(COUNT,3)_". "_$E($$GET1^DIQ(2,DFN,.01),1,25)  ;pat name
  1.  .. S LINE=$$PAD(LINE,32)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6)     ;chart #
  1.  .. S LINE=$$PAD(LINE,41)_$$NUMDATE^BDGF($$GET1^DIQ(405,ADM,.01,"I"))
  1.  .. S LINE=$$PAD(LINE,65)_$$GET1^DIQ(9000010,VST,1211)       ;acct #
  1.  .. D SET(LINE,COUNT,ADM,.VALMCNT)
  1.  .. S COUNT=COUNT+1
  1.  ;
  1.  I '$D(^TMP("BDGEAN",$J)) D SET("NO CURRENT INPATIENTS FOUND",0,0,.VALMCNT)
  1.  Q
  1.  ;
  1. SET(DATA,CNT,IEN,NUM) ; put display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGEAN",$J,NUM,0)=DATA
  1.  S ^TMP("BDGEAN",$J,"IDX",NUM,CNT)=IEN
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. EDIT ;EP; select patient from list and edit account #
  1.  NEW X,Y,Z,BDGN
  1.  D FULL^VALM1
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) Q
  1.  S X=0 F  S X=$O(VALMY(X)) Q:X=""  D
  1.  . S Y=0 F  S Y=$O(^TMP("BDGEAN",$J,"IDX",Y)) Q:Y=""  D
  1.  .. S Z=$O(^TMP("BDGEAN",$J,"IDX",Y,0))
  1.  .. Q:^TMP("BDGEAN",$J,"IDX",Y,Z)=""
  1.  .. I Z=X S BDGN=^TMP("BDGEAN",$J,"IDX",Y,Z)
  1.  ;
  1.  I '$G(BDGN) S VALMBCK="R" Q
  1.  ;
  1.  NEW VST S VST=$$GET1^DIQ(405,BDGN,.27,"I")
  1.  I 'VST W !!,"NO visit attached to admission; cannot edit" D PAUSE^BDGF S VALMBCK="R" Q
  1.  NEW DA,DR,DIE
  1.  W !,$$GET1^DIQ(9000010,VST,.05),?40,$$GET1^DIQ(9000010,VST,.01),!
  1.  S DIE="^AUPNVSIT(",DA=VST,DR=1211 D ^DIE
  1.  S VALMBCK="R" D HDR,INIT
  1.  Q
  1.  ;
  1. PRINT ;
  1.  NEW BDGPG
  1.  U IO D INIT^BDGF,HDG
  1.  S BDGX=0 F  S BDGX=$O(^TMP("BDGEAN",$J,BDGX)) Q:'BDGX  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BDGEAN",$J,BDGX,0)
  1.  D ^%ZISC,PRTKL^BDGF,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading when printing to paper
  1.  S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
  1.  W !,BDGTIME,?16,$$CONF^BDGF,?76,BDGUSR
  1.  W !,BDGDATE,?25,"Inpatients with Account Numbers",?71,"Page: ",BDGPG
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  W !?5,"Patient Name",?32,"Chart #",?41,"Admission Date"
  1.  W ?65,"Account #",!,$$REPEAT^XLFSTR("=",80)
  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)