- BDGEAN2 ; IHS/ANMC/LJF - INPTS W/OUT EXTERNAL ACCT # ;
- ;;5.3;PIMS;;APR 26, 2002
- ;
- NEW BDGBD,BDGED,X
- S BDGBD=$$READ^BDGF("DO^::E","Enter Earliest Admission Date") Q:'BDGBD
- S BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":E","Enter Latest Admission Date") Q:'BDGED
- S X=$$BROWSE^BDGF I X="B" D EN Q
- I X="P" D ZIS^BDGF("PQ","EN^BDGEAN2","INPT W/OUT ACCT #","BDGBD;BDGED")
- Q
- ;
- EN ; -- main entry point for BDG IPL W/OUT 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/OUT ACCT")
- D CLEAR^VALM1
- Q
- ;
- HDR ; -- header code
- Q
- ;
- INIT ; -- init variables and list array
- ; uses same tmp global as BDGEAN so same edit protocol works
- NEW BDGDT,BDGEND,BDGN,DFN,VST,LINE,COUNT
- S VALMCNT=0,COUNT=1
- K ^TMP("BDGEAN",$J)
- ;
- S BDGDT=BDGBD-.0001,BDGEND=BDGED+.2359
- F S BDGDT=$O(^DGPM("ATT1",BDGDT)) Q:'BDGDT Q:(BDGDT>BDGEND) D
- . S BDGN=0 F S BDGN=$O(^BDGPM("ATT1",BDGDT,BDGN)) Q:'BDGN D
- .. ;
- .. S VST=$$GET1^DIQ(405,BDGN,.27,"I")
- .. I VST,$$GET1^DIQ(9000010,VST,1211)]"" Q ;has acct #
- .. ;
- .. S DFN=$$GET1^DIQ(405,BDGN,.03,"I") Q:'DFN
- .. 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,BDGN,.01,"I"))
- .. S LINE=$$PAD(LINE,65)_$S('VST:"No PCC Visit for admission",1:"")
- .. D SET(LINE,COUNT,BDGN,.VALMCNT)
- .. S COUNT=COUNT+1
- ;
- I '$D(^TMP("BDGEAN",$J)) D SET("NO INPATIENTS FOUND FOR DATE RANGE",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
- ;
- 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,"Admissions witout Account Numbers",?71,"Page: ",BDGPG
- W !,$$REPEAT^XLFSTR("-",80)
- W !?5,"Patient Name",?32,"Chart #",?41,"Admission Date"
- W !,$$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)
- BDGEAN2 ; IHS/ANMC/LJF - INPTS W/OUT EXTERNAL ACCT # ;
- +1 ;;5.3;PIMS;;APR 26, 2002
- +2 ;
- +3 NEW BDGBD,BDGED,X
- +4 SET BDGBD=$$READ^BDGF("DO^::E","Enter Earliest Admission Date")
- IF 'BDGBD
- QUIT
- +5 SET BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":E","Enter Latest Admission Date")
- IF 'BDGED
- QUIT
- +6 SET X=$$BROWSE^BDGF
- IF X="B"
- DO EN
- QUIT
- +7 IF X="P"
- DO ZIS^BDGF("PQ","EN^BDGEAN2","INPT W/OUT ACCT #","BDGBD;BDGED")
- +8 QUIT
- +9 ;
- EN ; -- main entry point for BDG IPL W/OUT 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/OUT ACCT")
- +5 DO CLEAR^VALM1
- +6 QUIT
- +7 ;
- HDR ; -- header code
- +1 QUIT
- +2 ;
- INIT ; -- init variables and list array
- +1 ; uses same tmp global as BDGEAN so same edit protocol works
- +2 NEW BDGDT,BDGEND,BDGN,DFN,VST,LINE,COUNT
- +3 SET VALMCNT=0
- SET COUNT=1
- +4 KILL ^TMP("BDGEAN",$JOB)
- +5 ;
- +6 SET BDGDT=BDGBD-.0001
- SET BDGEND=BDGED+.2359
- +7 FOR
- SET BDGDT=$ORDER(^DGPM("ATT1",BDGDT))
- IF 'BDGDT
- QUIT
- IF (BDGDT>BDGEND)
- QUIT
- Begin DoDot:1
- +8 SET BDGN=0
- FOR
- SET BDGN=$ORDER(^BDGPM("ATT1",BDGDT,BDGN))
- IF 'BDGN
- QUIT
- Begin DoDot:2
- +9 ;
- +10 SET VST=$$GET1^DIQ(405,BDGN,.27,"I")
- +11 ;has acct #
- IF VST
- IF $$GET1^DIQ(9000010,VST,1211)]""
- QUIT
- +12 ;
- +13 SET DFN=$$GET1^DIQ(405,BDGN,.03,"I")
- IF 'DFN
- QUIT
- +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,BDGN,.01,"I"))
- +17 SET LINE=$$PAD(LINE,65)_$SELECT('VST:"No PCC Visit for admission",1:"")
- +18 DO SET(LINE,COUNT,BDGN,.VALMCNT)
- +19 SET COUNT=COUNT+1
- End DoDot:2
- End DoDot:1
- +20 ;
- +21 IF '$DATA(^TMP("BDGEAN",$JOB))
- DO SET("NO INPATIENTS FOUND FOR DATE RANGE",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 ;
- 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,"Admissions witout Account Numbers",?71,"Page: ",BDGPG
- +4 WRITE !,$$REPEAT^XLFSTR("-",80)
- +5 WRITE !?5,"Patient Name",?32,"Chart #",?41,"Admission Date"
- +6 WRITE !,$$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)
