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