- BDGIPL7 ; IHS/ANMC/LJF - CURR INPTS W/INSURANCE ;
- ;;5.3;PIMS;**1007,1009,1010**;FEB 27, 2007
- ;
- ;
- ;cmi/anch/maw 2/22/2007 added code in PRINT to not close device if multiple copies PATCH 1007 item 1007.39
- ;cmi/anch/maw 2/22/2007 added code in INIT and INITC to sort by coverage type PATCH 1007 item 1007.40.
- ;cmi/anch/maw 05/08/2008 PATCH 1009 requirements 22,31,71 for insurance display
- ;
- ;
- I $E(IOST,1,2)="P-" D INIT,PRINT Q
- ;
- EN ; -- main entry point for BDG IPL INSURANCE
- ; assumes BDGSRT is set
- NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
- D EN^VALM("BDG IPL INSURANCE")
- D CLEAR^VALM1
- Q
- ;
- HDR ; -- header code
- NEW X
- S VALMHDR(1)=$$SP(12)_"** "_$$CONF^BDGF_" **"
- S X=$S(BDGSRT="A":"For ALL Ward Locations",1:$P(BDGSRT,U,2))
- S VALMHDR(2)=$$SP(75-$L(X)\2)_X
- Q
- ;
- INIT ; -- init variables and list array
- NEW WD,DFN,BDGCNT,NAME,FIRST
- K ^TMP("BDGIPL",$J),^TMP("BDGIPL1",$J)
- S VALMCNT=0,BDGCNT=1,FIRST=1
- ;
- I $G(BDGSRT2)="C" D INITC Q ;cmi/anch/maw 2/22/2007 added for Coverage Type
- ; if only one ward chosen
- I BDGSRT D
- . S WD=$P(BDGSRT,U,2),DFN=0 F S DFN=$O(^DPT("CN",WD,DFN)) Q:'DFN D
- .. S ^TMP("BDGIPL1",$J,WD,$$GET1^DIQ(2,DFN,.01),DFN)=""
- ;
- ; OR for all wards, find current inpatients & sort by ward then name
- E S WD=0 F S WD=$O(^DPT("CN",WD)) Q:WD="" D
- . S DFN=0 F S DFN=$O(^DPT("CN",WD,DFN)) Q:'DFN D
- .. S ^TMP("BDGIPL1",$J,WD,$$GET1^DIQ(2,DFN,.01),DFN)=""
- ;
- ; pull sorted list and create display array
- S WD=0 F S WD=$O(^TMP("BDGIPL1",$J,WD)) Q:WD="" D
- . ;
- . I BDGSRT="A" D ;display ward subheading
- .. ;
- .. ; if printer, mark stop to add form feed
- .. I 'FIRST,$E(IOST,1,2)="P-" D SET("@@@@",.VALMCNT,BDGCNT,"")
- .. S FIRST=0
- .. ;
- .. D SET($G(IORVON)_"WARD: "_WD_$G(IORVOFF),.VALMCNT,BDGCNT,"")
- . ;
- . S NAME=0 F S NAME=$O(^TMP("BDGIPL1",$J,WD,NAME)) Q:NAME="" D
- .. S DFN=0 F S DFN=$O(^TMP("BDGIPL1",$J,WD,NAME,DFN)) Q:'DFN D
- ... D LINE
- ;
- K ^TMP("BDGIPL1",$J)
- Q
- ;
- INITC ;-- init variables for coverage type and list array
- ;cmi/anch/maw 2/22/2007 added to sort by coverage type patch 1007 item 1007.40
- ;cmi/anch/maw 5/08/2008 changed insurance call to new insurance calls in BDGF2
- N BDGADM,BDGCOV,BDGMCR,BDGMCD,BDGRR,BDGRAIL
- I BDGSRT D
- . S WD=$P(BDGSRT,U,2),DFN=0 F S DFN=$O(^DPT("CN",WD,DFN)) Q:'DFN D
- . S BDGCOV=0 ;used to find patients with no coverage
- . S BDGADM=+$$GET1^DIQ(2,DFN,.105,"I") ;admit ien
- . S BDGMCD=$$NEWINS^BDGF2(DFN,BDGADM,"MCD") ;medicaid # if any
- . I $G(BDGMCD)]"" S BDGCOV="MCD"
- . S BDGMCR=$$NEWINS^BDGF2(DFN,BDGADM,"MCR") ;medicare # if any
- . I $G(BDGMCR)]"" S BDGCOV="MCR"
- . S BDGRAIL=$$NEWINS^BDGF2(DFN,BDGADM,"RR")
- . I $G(BDGRAIL)]"" S BDGCOV="RR"
- . D NEWINS^BDGF2(DFN,BDGADM,"PI") ;check for pvt ins
- . I $D(BDGRR) S BDGCOV="PI"
- . I BDGCOV=0 S BDGCOV="ZZ"
- . S ^TMP("BDGIPL1",$J,WD,BDGCOV,$$GET1^DIQ(2,DFN,.01),DFN)=""
- ;
- ; OR for all wards, find current inpatients & sort by ward then name
- E S WD=0 F S WD=$O(^DPT("CN",WD)) Q:WD="" D
- . S DFN=0 F S DFN=$O(^DPT("CN",WD,DFN)) Q:'DFN D
- .. S BDGCOV=0 ;used to find patients with no coverage
- .. S BDGADM=+$$GET1^DIQ(2,DFN,.105,"I") ;admit ien
- .. ;S BDGMCD=$$MCD^BDGF2(DFN,BDGADM) ;medicaid # if any
- .. ;I BDGMCD S BDGCOV="MCD"
- .. ;S BDGMCR=$$MCR^BDGF2(DFN,BDGADM) ;medicare # if any
- .. ;I BDGMCR S BDGCOV="MCR"
- .. ;D INS^BDGF2(DFN,BDGADM,.BDGRR) ;check for pvt ins
- .. ;I $D(BDGRR) S BDGCOV="PI"
- .. ;cmi/maw 5/8/2008 PATCH 1009 next lines for new insurance display
- .. S BDGMCD=$$NEWINS^BDGF2(DFN,BDGADM,"MCD") ;medicaid # if any
- .. I $G(BDGMCD)]"" S BDGCOV="MCD"
- .. S BDGMCR=$$NEWINS^BDGF2(DFN,BDGADM,"MCR") ;medicare # if any
- .. I $G(BDGMCR)]"" S BDGCOV="MCR"
- .. S BDGRAIL=$$NEWINS^BDGF2(DFN,BDGADM,"RR")
- .. I $G(BDGRAIL)]"" S BDGCOV="RR"
- .. D NEWINS^BDGF2(DFN,BDGADM,"PI") ;check for pvt ins
- .. I BDGCOV=0 S BDGCOV="ZZ"
- .. S ^TMP("BDGIPL1",$J,WD,BDGCOV,$$GET1^DIQ(2,DFN,.01),DFN)=""
- ;
- ; pull sorted list and create display array
- S WD=0 F S WD=$O(^TMP("BDGIPL1",$J,WD)) Q:WD="" D
- . ;
- . I BDGSRT="A" D ;display ward subheading
- .. ;
- .. ; if printer, mark stop to add form feed
- .. I 'FIRST,$E(IOST,1,2)="P-" D SET("@@@@",.VALMCNT,BDGCNT,"")
- .. S FIRST=0
- .. ;
- .. D SET($G(IORVON)_"WARD: "_WD_$G(IORVOFF),.VALMCNT,BDGCNT,"")
- . ;
- . N COV
- . S COV=0 F S COV=$O(^TMP("BDGIPL1",$J,WD,COV)) Q:COV="" D
- .. S NAME=0 F S NAME=$O(^TMP("BDGIPL1",$J,WD,COV,NAME)) Q:NAME="" D
- ... S DFN=0 F S DFN=$O(^TMP("BDGIPL1",$J,WD,COV,NAME,DFN)) Q:'DFN D
- .... D LINE
- ;
- K ^TMP("BDGIPL1",$J)
- Q
- ;
- LINE ; set up dislay line for patient
- NEW LINE,BDGCOV,ADM
- S LINE=$S($E(IOST,1,2)="P-":$$SP(5),1:$J(BDGCNT,3)_") ")
- S LINE=$$PAD(LINE,5)_$E($$GET1^DIQ(2,DFN,.01),1,18) ;name
- S LINE=$$PAD(LINE,25)_$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2))) ;chart#
- S LINE=$$PAD(LINE,35)_$G(^DPT(DFN,.101)) ;room
- S LINE=$$PAD(LINE,43)_$$GET1^DIQ(45.7,+$G(^DPT(DFN,.103)),99) ;srv
- S LINE=$$PAD(LINE,50)_$E($P($$CURPRV^BDGF1(DFN),"/"),1,15) ;prim prov
- S LINE=$$PAD(LINE,67)_$P($$INPT1^BDGF1(DFN,DT),"@") ;admit date
- D SET(LINE,.VALMCNT,BDGCNT,DFN)
- ;
- ; display diagnosis & M/M info
- S LINE=$$SP(5)_"Adx Dx: "_$E($$GET1^DIQ(405,+$G(^DPT(DFN,.105)),.1),1,23)
- S BDGCOV=0 ;used to find patients with no coverage
- S ADM=+$$GET1^DIQ(2,DFN,.105,"I") ;admit ien
- ;cmi/anch/maw 5/8/2008 PATCH 1009 next lines for new insurance display
- ;S X=$$MCR^BDGF2(DFN,IEN),Y=$$MCD^BDGF2(DFN,IEN) ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31 orig line
- ;D INS^BDGF2(DFN,IEN,.BDGRR) ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31 orig line
- N BDGW,BDGX,BDGY,BDGZ,BDGRR
- S BDGX=$$NEWINS^BDGF2(DFN,ADM,"MCR"),BDGY=$$NEWINS^BDGF2(DFN,ADM,"MCD") ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31
- S BDGW=$$NEWINS^BDGF2(DFN,ADM,"RR"),BDGZ=$$NEWINS^BDGF2(DFN,ADM,"PI") ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31 7/30/2009 PATCH 1010 reversed RR and PI calls
- ;I BDGCOV=0 D SET($$SP(10)_"**No Additional Coverage**",.VALMCNT) Q
- I (BDGW]"")!(BDGX]"")!(BDGY]"") S LINE=$$SP(5)_BDGX_$$SP(2)_BDGY_$$SP(2)_BDGW ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31
- ;I (X]"")!(Y]"") D SET($$PAD($$SP(10)_X,40)_Y,.VALMCNT) ;cmi/anch/maw 5/2/2008 PATCH 1009 orig line
- ;S LINE=$$PAD(LINE,38)_$$MCD^BDGF2(DFN,ADM) ;medicaid # if any
- ;S LINE=$$PAD(LINE,60)_$$MCR^BDGF2(DFN,ADM) ;medicare # if any
- ;D INS^BDGF2(DFN,ADM,.BDGRR) ;check for pvt ins
- I BDGCOV=0 S LINE=$$PAD(LINE,38)_"No Additional Coverage"
- D SET(LINE,.VALMCNT,BDGCNT,DFN)
- ;
- ; display all current private insurance coverage
- S I=0 F S I=$O(BDGRR(I)) Q:'I D
- . D SET($$SP(5)_BDGRR(I),.VALMCNT,BDGCNT,DFN)
- ;
- D SET("",.VALMCNT,BDGCNT,"")
- ;
- ; increment counter
- S BDGCNT=BDGCNT+1
- Q
- ;
- SET(LINE,NUM,COUNT,IEN) ; put display line into array
- D SET^BDGIPL1(LINE,.NUM,COUNT,IEN)
- Q
- ;
- PRINT ; print report to paper
- NEW BDGX,BDGLN,BDGPG
- U IO D INIT^BDGF,HDG
- ;
- ; loop thru display array
- S BDGX=0 F S BDGX=$O(^TMP("BDGIPL",$J,BDGX)) Q:'BDGX D
- . S BDGLN=^TMP("BDGIPL",$J,BDGX,0)
- . ;
- . ;marker for form feed between wards
- . I $E(BDGLN,1,4)="@@@@" D HDG Q
- . ;
- . I $Y>(IOSL-4) D HDG
- . W !,BDGLN
- I '$G(BDGCOP) D ^%ZISC ;cmi/anch/maw 2/22/2007 added for no close of device if multiple copies PATCH 1007 item 1007.39
- D PRTKL^BDGF,EXIT
- ;D ^%ZISC,PRTKL^BDGF,EXIT cmi/anch/maw 2/22/2007 orig line
- Q ;cmi/anch/maw 7/25/2007 quit missing patch 1007
- ;
- HDG ; heading for paper report
- S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
- W !,BDGUSR,?16,$$CONF^BDGF
- W !,BDGDATE,?20,"Insurance Coverage for Current Inpatients"
- W ?71,"Page: ",BDGPG
- S X=$S(BDGSRT="A":"For ALL Ward Locations",1:$P(BDGSRT,U,2))
- W !,BDGTIME,?(80-$L(X)\2),X
- W !,$$REPEAT^XLFSTR("-",80)
- W !?5,"Patient",?25,"Chart #",?35,"Room",?43,"Srv",?50,"Provider"
- W ?67,"Admit Date"
- W !,$$REPEAT^XLFSTR("=",80)
- Q
- ;
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("BDGIPL",$J)
- ;K BDGSRT cmi/anch/maw 7/25/2007 is needed for multiple copies patch 1007
- Q
- ;
- EXPND ; -- expand code
- 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)
- BDGIPL7 ; IHS/ANMC/LJF - CURR INPTS W/INSURANCE ;
- +1 ;;5.3;PIMS;**1007,1009,1010**;FEB 27, 2007
- +2 ;
- +3 ;
- +4 ;cmi/anch/maw 2/22/2007 added code in PRINT to not close device if multiple copies PATCH 1007 item 1007.39
- +5 ;cmi/anch/maw 2/22/2007 added code in INIT and INITC to sort by coverage type PATCH 1007 item 1007.40.
- +6 ;cmi/anch/maw 05/08/2008 PATCH 1009 requirements 22,31,71 for insurance display
- +7 ;
- +8 ;
- +9 IF $EXTRACT(IOST,1,2)="P-"
- DO INIT
- DO PRINT
- QUIT
- +10 ;
- EN ; -- main entry point for BDG IPL INSURANCE
- +1 ; assumes BDGSRT is set
- +2 NEW VALMCNT
- DO TERM^VALM0
- DO CLEAR^VALM1
- +3 DO EN^VALM("BDG IPL INSURANCE")
- +4 DO CLEAR^VALM1
- +5 QUIT
- +6 ;
- HDR ; -- header code
- +1 NEW X
- +2 SET VALMHDR(1)=$$SP(12)_"** "_$$CONF^BDGF_" **"
- +3 SET X=$SELECT(BDGSRT="A":"For ALL Ward Locations",1:$PIECE(BDGSRT,U,2))
- +4 SET VALMHDR(2)=$$SP(75-$LENGTH(X)\2)_X
- +5 QUIT
- +6 ;
- INIT ; -- init variables and list array
- +1 NEW WD,DFN,BDGCNT,NAME,FIRST
- +2 KILL ^TMP("BDGIPL",$JOB),^TMP("BDGIPL1",$JOB)
- +3 SET VALMCNT=0
- SET BDGCNT=1
- SET FIRST=1
- +4 ;
- +5 ;cmi/anch/maw 2/22/2007 added for Coverage Type
- IF $GET(BDGSRT2)="C"
- DO INITC
- QUIT
- +6 ; if only one ward chosen
- +7 IF BDGSRT
- Begin DoDot:1
- +8 SET WD=$PIECE(BDGSRT,U,2)
- SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("CN",WD,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +9 SET ^TMP("BDGIPL1",$JOB,WD,$$GET1^DIQ(2,DFN,.01),DFN)=""
- End DoDot:2
- End DoDot:1
- +10 ;
- +11 ; OR for all wards, find current inpatients & sort by ward then name
- +12 IF '$TEST
- SET WD=0
- FOR
- SET WD=$ORDER(^DPT("CN",WD))
- IF WD=""
- QUIT
- Begin DoDot:1
- +13 SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("CN",WD,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +14 SET ^TMP("BDGIPL1",$JOB,WD,$$GET1^DIQ(2,DFN,.01),DFN)=""
- End DoDot:2
- End DoDot:1
- +15 ;
- +16 ; pull sorted list and create display array
- +17 SET WD=0
- FOR
- SET WD=$ORDER(^TMP("BDGIPL1",$JOB,WD))
- IF WD=""
- QUIT
- Begin DoDot:1
- +18 ;
- +19 ;display ward subheading
- IF BDGSRT="A"
- Begin DoDot:2
- +20 ;
- +21 ; if printer, mark stop to add form feed
- +22 IF 'FIRST
- IF $EXTRACT(IOST,1,2)="P-"
- DO SET("@@@@",.VALMCNT,BDGCNT,"")
- +23 SET FIRST=0
- +24 ;
- +25 DO SET($GET(IORVON)_"WARD: "_WD_$GET(IORVOFF),.VALMCNT,BDGCNT,"")
- End DoDot:2
- +26 ;
- +27 SET NAME=0
- FOR
- SET NAME=$ORDER(^TMP("BDGIPL1",$JOB,WD,NAME))
- IF NAME=""
- QUIT
- Begin DoDot:2
- +28 SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP("BDGIPL1",$JOB,WD,NAME,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:3
- +29 DO LINE
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 KILL ^TMP("BDGIPL1",$JOB)
- +32 QUIT
- +33 ;
- INITC ;-- init variables for coverage type and list array
- +1 ;cmi/anch/maw 2/22/2007 added to sort by coverage type patch 1007 item 1007.40
- +2 ;cmi/anch/maw 5/08/2008 changed insurance call to new insurance calls in BDGF2
- +3 NEW BDGADM,BDGCOV,BDGMCR,BDGMCD,BDGRR,BDGRAIL
- +4 IF BDGSRT
- Begin DoDot:1
- +5 SET WD=$PIECE(BDGSRT,U,2)
- SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("CN",WD,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- End DoDot:2
- +6 ;used to find patients with no coverage
- SET BDGCOV=0
- +7 ;admit ien
- SET BDGADM=+$$GET1^DIQ(2,DFN,.105,"I")
- +8 ;medicaid # if any
- SET BDGMCD=$$NEWINS^BDGF2(DFN,BDGADM,"MCD")
- +9 IF $GET(BDGMCD)]""
- SET BDGCOV="MCD"
- +10 ;medicare # if any
- SET BDGMCR=$$NEWINS^BDGF2(DFN,BDGADM,"MCR")
- +11 IF $GET(BDGMCR)]""
- SET BDGCOV="MCR"
- +12 SET BDGRAIL=$$NEWINS^BDGF2(DFN,BDGADM,"RR")
- +13 IF $GET(BDGRAIL)]""
- SET BDGCOV="RR"
- +14 ;check for pvt ins
- DO NEWINS^BDGF2(DFN,BDGADM,"PI")
- +15 IF $DATA(BDGRR)
- SET BDGCOV="PI"
- +16 IF BDGCOV=0
- SET BDGCOV="ZZ"
- +17 SET ^TMP("BDGIPL1",$JOB,WD,BDGCOV,$$GET1^DIQ(2,DFN,.01),DFN)=""
- End DoDot:1
- +18 ;
- +19 ; OR for all wards, find current inpatients & sort by ward then name
- +20 IF '$TEST
- SET WD=0
- FOR
- SET WD=$ORDER(^DPT("CN",WD))
- IF WD=""
- QUIT
- Begin DoDot:1
- +21 SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("CN",WD,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +22 ;used to find patients with no coverage
- SET BDGCOV=0
- +23 ;admit ien
- SET BDGADM=+$$GET1^DIQ(2,DFN,.105,"I")
- +24 ;S BDGMCD=$$MCD^BDGF2(DFN,BDGADM) ;medicaid # if any
- +25 ;I BDGMCD S BDGCOV="MCD"
- +26 ;S BDGMCR=$$MCR^BDGF2(DFN,BDGADM) ;medicare # if any
- +27 ;I BDGMCR S BDGCOV="MCR"
- +28 ;D INS^BDGF2(DFN,BDGADM,.BDGRR) ;check for pvt ins
- +29 ;I $D(BDGRR) S BDGCOV="PI"
- +30 ;cmi/maw 5/8/2008 PATCH 1009 next lines for new insurance display
- +31 ;medicaid # if any
- SET BDGMCD=$$NEWINS^BDGF2(DFN,BDGADM,"MCD")
- +32 IF $GET(BDGMCD)]""
- SET BDGCOV="MCD"
- +33 ;medicare # if any
- SET BDGMCR=$$NEWINS^BDGF2(DFN,BDGADM,"MCR")
- +34 IF $GET(BDGMCR)]""
- SET BDGCOV="MCR"
- +35 SET BDGRAIL=$$NEWINS^BDGF2(DFN,BDGADM,"RR")
- +36 IF $GET(BDGRAIL)]""
- SET BDGCOV="RR"
- +37 ;check for pvt ins
- DO NEWINS^BDGF2(DFN,BDGADM,"PI")
- +38 IF BDGCOV=0
- SET BDGCOV="ZZ"
- +39 SET ^TMP("BDGIPL1",$JOB,WD,BDGCOV,$$GET1^DIQ(2,DFN,.01),DFN)=""
- End DoDot:2
- End DoDot:1
- +40 ;
- +41 ; pull sorted list and create display array
- +42 SET WD=0
- FOR
- SET WD=$ORDER(^TMP("BDGIPL1",$JOB,WD))
- IF WD=""
- QUIT
- Begin DoDot:1
- +43 ;
- +44 ;display ward subheading
- IF BDGSRT="A"
- Begin DoDot:2
- +45 ;
- +46 ; if printer, mark stop to add form feed
- +47 IF 'FIRST
- IF $EXTRACT(IOST,1,2)="P-"
- DO SET("@@@@",.VALMCNT,BDGCNT,"")
- +48 SET FIRST=0
- +49 ;
- +50 DO SET($GET(IORVON)_"WARD: "_WD_$GET(IORVOFF),.VALMCNT,BDGCNT,"")
- End DoDot:2
- +51 ;
- +52 NEW COV
- +53 SET COV=0
- FOR
- SET COV=$ORDER(^TMP("BDGIPL1",$JOB,WD,COV))
- IF COV=""
- QUIT
- Begin DoDot:2
- +54 SET NAME=0
- FOR
- SET NAME=$ORDER(^TMP("BDGIPL1",$JOB,WD,COV,NAME))
- IF NAME=""
- QUIT
- Begin DoDot:3
- +55 SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP("BDGIPL1",$JOB,WD,COV,NAME,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:4
- +56 DO LINE
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +57 ;
- +58 KILL ^TMP("BDGIPL1",$JOB)
- +59 QUIT
- +60 ;
- LINE ; set up dislay line for patient
- +1 NEW LINE,BDGCOV,ADM
- +2 SET LINE=$SELECT($EXTRACT(IOST,1,2)="P-":$$SP(5),1:$JUSTIFY(BDGCNT,3)_") ")
- +3 ;name
- SET LINE=$$PAD(LINE,5)_$EXTRACT($$GET1^DIQ(2,DFN,.01),1,18)
- +4 ;chart#
- SET LINE=$$PAD(LINE,25)_$$HRCND^BDGF2($$HRCN^BDGF2(DFN,DUZ(2)))
- +5 ;room
- SET LINE=$$PAD(LINE,35)_$GET(^DPT(DFN,.101))
- +6 ;srv
- SET LINE=$$PAD(LINE,43)_$$GET1^DIQ(45.7,+$GET(^DPT(DFN,.103)),99)
- +7 ;prim prov
- SET LINE=$$PAD(LINE,50)_$EXTRACT($PIECE($$CURPRV^BDGF1(DFN),"/"),1,15)
- +8 ;admit date
- SET LINE=$$PAD(LINE,67)_$PIECE($$INPT1^BDGF1(DFN,DT),"@")
- +9 DO SET(LINE,.VALMCNT,BDGCNT,DFN)
- +10 ;
- +11 ; display diagnosis & M/M info
- +12 SET LINE=$$SP(5)_"Adx Dx: "_$EXTRACT($$GET1^DIQ(405,+$GET(^DPT(DFN,.105)),.1),1,23)
- +13 ;used to find patients with no coverage
- SET BDGCOV=0
- +14 ;admit ien
- SET ADM=+$$GET1^DIQ(2,DFN,.105,"I")
- +15 ;cmi/anch/maw 5/8/2008 PATCH 1009 next lines for new insurance display
- +16 ;S X=$$MCR^BDGF2(DFN,IEN),Y=$$MCD^BDGF2(DFN,IEN) ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31 orig line
- +17 ;D INS^BDGF2(DFN,IEN,.BDGRR) ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31 orig line
- +18 NEW BDGW,BDGX,BDGY,BDGZ,BDGRR
- +19 ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31
- SET BDGX=$$NEWINS^BDGF2(DFN,ADM,"MCR")
- SET BDGY=$$NEWINS^BDGF2(DFN,ADM,"MCD")
- +20 ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31 7/30/2009 PATCH 1010 reversed RR and PI calls
- SET BDGW=$$NEWINS^BDGF2(DFN,ADM,"RR")
- SET BDGZ=$$NEWINS^BDGF2(DFN,ADM,"PI")
- +21 ;I BDGCOV=0 D SET($$SP(10)_"**No Additional Coverage**",.VALMCNT) Q
- +22 ;cmi/anch/maw 5/2/2008 PATCH 1009 requirements 22,31
- IF (BDGW]"")!(BDGX]"")!(BDGY]"")
- SET LINE=$$SP(5)_BDGX_$$SP(2)_BDGY_$$SP(2)_BDGW
- +23 ;I (X]"")!(Y]"") D SET($$PAD($$SP(10)_X,40)_Y,.VALMCNT) ;cmi/anch/maw 5/2/2008 PATCH 1009 orig line
- +24 ;S LINE=$$PAD(LINE,38)_$$MCD^BDGF2(DFN,ADM) ;medicaid # if any
- +25 ;S LINE=$$PAD(LINE,60)_$$MCR^BDGF2(DFN,ADM) ;medicare # if any
- +26 ;D INS^BDGF2(DFN,ADM,.BDGRR) ;check for pvt ins
- +27 IF BDGCOV=0
- SET LINE=$$PAD(LINE,38)_"No Additional Coverage"
- +28 DO SET(LINE,.VALMCNT,BDGCNT,DFN)
- +29 ;
- +30 ; display all current private insurance coverage
- +31 SET I=0
- FOR
- SET I=$ORDER(BDGRR(I))
- IF 'I
- QUIT
- Begin DoDot:1
- +32 DO SET($$SP(5)_BDGRR(I),.VALMCNT,BDGCNT,DFN)
- End DoDot:1
- +33 ;
- +34 DO SET("",.VALMCNT,BDGCNT,"")
- +35 ;
- +36 ; increment counter
- +37 SET BDGCNT=BDGCNT+1
- +38 QUIT
- +39 ;
- SET(LINE,NUM,COUNT,IEN) ; put display line into array
- +1 DO SET^BDGIPL1(LINE,.NUM,COUNT,IEN)
- +2 QUIT
- +3 ;
- PRINT ; print report to paper
- +1 NEW BDGX,BDGLN,BDGPG
- +2 USE IO
- DO INIT^BDGF
- DO HDG
- +3 ;
- +4 ; loop thru display array
- +5 SET BDGX=0
- FOR
- SET BDGX=$ORDER(^TMP("BDGIPL",$JOB,BDGX))
- IF 'BDGX
- QUIT
- Begin DoDot:1
- +6 SET BDGLN=^TMP("BDGIPL",$JOB,BDGX,0)
- +7 ;
- +8 ;marker for form feed between wards
- +9 IF $EXTRACT(BDGLN,1,4)="@@@@"
- DO HDG
- QUIT
- +10 ;
- +11 IF $Y>(IOSL-4)
- DO HDG
- +12 WRITE !,BDGLN
- End DoDot:1
- +13 ;cmi/anch/maw 2/22/2007 added for no close of device if multiple copies PATCH 1007 item 1007.39
- IF '$GET(BDGCOP)
- DO ^%ZISC
- +14 DO PRTKL^BDGF
- DO EXIT
- +15 ;D ^%ZISC,PRTKL^BDGF,EXIT cmi/anch/maw 2/22/2007 orig line
- +16 ;cmi/anch/maw 7/25/2007 quit missing patch 1007
- QUIT
- +17 ;
- HDG ; heading for paper report
- +1 SET BDGPG=$GET(BDGPG)+1
- IF BDGPG>1
- WRITE @IOF
- +2 WRITE !,BDGUSR,?16,$$CONF^BDGF
- +3 WRITE !,BDGDATE,?20,"Insurance Coverage for Current Inpatients"
- +4 WRITE ?71,"Page: ",BDGPG
- +5 SET X=$SELECT(BDGSRT="A":"For ALL Ward Locations",1:$PIECE(BDGSRT,U,2))
- +6 WRITE !,BDGTIME,?(80-$LENGTH(X)\2),X
- +7 WRITE !,$$REPEAT^XLFSTR("-",80)
- +8 WRITE !?5,"Patient",?25,"Chart #",?35,"Room",?43,"Srv",?50,"Provider"
- +9 WRITE ?67,"Admit Date"
- +10 WRITE !,$$REPEAT^XLFSTR("=",80)
- +11 QUIT
- +12 ;
- +13 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("BDGIPL",$JOB)
- +2 ;K BDGSRT cmi/anch/maw 7/25/2007 is needed for multiple copies patch 1007
- +3 QUIT
- +4 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- 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)
