- BPSSCR02 ;BHAM ISC/SS - USER SCREEN UTILITIES ;05-APR-05
- ;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,10,11**;JUN 2004;Build 27
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;USER SCREEN
- ;
- REVERSE ;
- N BPSDFN,BPSRX
- D SELECT(.BPSDFN,.BPSRX)
- S VALMBCK="R"
- Q
- ;
- SELECT(BPSDFN1,BPSRX1,BPSRF1,BPS59) ; Select a patient. Returns patient IEN(s) in array
- N BPLN
- S BPLN=$$SELLINE("Select the line(s) with the paid claim(s) you wish to REVERSE","")
- Q
- ;
- SELLINE(BPSPROM,BPSDFVL) ;
- N BPRET,DIR,X,Y,DIRUT
- S BPRET="^"
- W ! S DIR(0)="N^::2",DIR("A")=BPSPROM,DIR("B")=BPSDFVL D ^DIR I $D(DIRUT) Q "^"
- S $P(BPRET,U)=Y
- Q BPRET
- ;/**
- ;make array element
- ;BPLINE - line number in LM ARRAY (by ref)
- ;BPTMP - VALMAR (TMP global for LM)
- ;BP59 - ptr to 9002313.59
- ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
- ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
- ;TMP structure gives on the screen:
- ;^TMP("BPSSCR",$J,"VALM","LMIND",1,0,DFN,0,0)=
- ;^TMP("BPSSCR",$J,"VALM",1,0)=1 BUMSTEAD,CHARLE (5444)/100-234-2345 *done* FINISHED
- ;BPLINE = 1
- ;BPLMIND=1
- ;on the screen:
- ;1 BUMSTEAD,CHARLE (5444) /100-234-2345 *done* FINISHED
- ;
- ;^TMP(538978189,"BPSSCR","SORT","T",1,401959.00001)=
- ;^TMP("BPSSCR",$J,"VALM","LMIND",1,1,DFN,401959.00001,1)=
- ;^TMP("BPSSCR",$J,"VALM",2,0)= 1.1 LOVASTATIN 20MG TAB
- ;BPLINE = 2
- ;BP59= 401959.00001
- ;on the screen:
- ; 1.1 LOVASTATIN 20MG TAB
- ;
- ;^TMP(538978189,"BPSSCR","SORT","T",1,501750.00011)=
- ;^TMP("BPSSCR",$J,"VALM","LMIND",1,2,DFN,501750.00011,2)=
- ;^TMP("BPSSCR",$J,"VALM",3,0)= 1.2 CIMETIDINE 300MG TAB
- ;BPLINE = 3
- ;BP59= 501750.00011
- ;on the screen:
- ; 1.2 CIMETIDINE 300MG TAB
- ;
- MKARRELM(BPLINE,BPTMP,BP59,BPLMIND,BPDRIND,BPPREV) ;*/
- N BPSSTR,BPLNS,BPDFN,BPSTAT,BPSINSUR,BPINSDAT
- S BPDFN=+$P($G(^BPST(BP59,0)),U,6) ;patient's DFN
- S BPINSDAT=$$GETINSUR^BPSSCRU2(BP59)
- S BPSINSUR=+BPINSDAT ;patient's insurance IEN
- ;
- ;PATIENT SUMMARY level
- ; if last one was different DFN/INSURANCE combination then create a new Patient Summary level
- I (+$O(@BPTMP@("LMIND",BPLMIND,0,0))'=BPDFN)!(+$O(@BPTMP@("LMIND",BPLMIND,0,BPDFN,0))'=BPSINSUR) D
- . ;-------- first process previous patient & insurance group
- . ;determine patient summary statuses for the previous "patient" group
- . I BPLMIND>0,+BPPREV=BPLMIND D
- . . ;update the record for previous patient summary after we went thru all his claims
- . . D UPDPREV(BPTMP,BPLMIND,BPPREV)
- . ;process new "patient & insurance" group ------------------
- . S BPDRIND=0
- . S BPLMIND=(BPLMIND\1)+1
- . ;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on
- . S BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF(BPDFN,BPINSDAT)_U_BPSINSUR
- . S BPSSTR=$$LJ(BPLMIND,4)_$P(BPPREV,U,4)
- . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,BPSINSUR)
- . S BPLINE=BPLINE+1
- ;
- ;CLAIMS level
- D
- . I +$O(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59 D
- . . S BPDRIND=BPDRIND+1
- . . S BPSSTR=" "_$$LJ(+$P(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF(BP59)
- . . ;@debug,remove the next line after finish debugging
- . . ;S BPSSTR=BPSSTR_" 59:"_BP59_" DT:"_$$TRANDT^BPSSCRU2(BP59)_" DFN:"_BPDFN_" INS:"_BPSINSUR
- . . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR)
- . . S BPLINE=BPLINE+1
- . . N BPARR,X
- . . S BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"R")
- . . F X=1:1:BPLNS D
- . . . I $G(BPARR(X))="" Q
- . . . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR)
- . . . S BPLINE=BPLINE+1
- Q
- ;S BPS=BPX
- ;/**
- ;BP59
- CLAIMINF(BP59) ;*/
- N BPX,BPX1,DOSDT
- S BPX1=$$RXREF^BPSSCRU2(BP59)
- S BPX=$$LJ($$DRGNAME^BPSSCRU2(BP59),17)_" "_$$LJ($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),11)_" "
- ;
- ;SLT - BPS*1.0*11
- S DOSDT=$$LASTDOS^BPSUTIL2(BP59,0)
- ;
- S BPX=BPX_$$LJ(DOSDT,5)_" "
- S BPX=BPX_$$LJ($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$P(BPX1,U,2)_"/"
- S BPX=BPX_$$LJ($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" "
- S BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59)
- Q BPX
- ;/**
- ;determine "done" and "FINISHED" status for patient/insurance group by BPLMIND in TMP global
- STAT4PAT(BPLMIND) ;*/
- N BPCL,BPDFN,BP59,BPX,BPINS,BPX,BPCNT,BPELI
- N BPPB,BPRJ,BPACRV,BPRJRV,BPSR,BPFIN,BPPRCNTG
- S (BPCL,BPPB,BPRJ,BPACRV,BPSR,BPRJRV)=0
- S BPFIN=0 ; finished by default
- S BPPRCNTG=0
- S BPCNT=0
- F S BPCL=+$O(@BPTMP@("LMIND",BPLMIND,BPCL)) Q:BPCL=0 D
- . S BPDFN=0
- . F S BPDFN=+$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN)) Q:BPDFN=0 D
- . . S BPINS="" ;can be 0 in the TMP global if insurance plan
- . . ;is corrupted in file ##9002313.59
- . . F S BPINS=$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS)) Q:BPINS="" D
- . . . S BP59=0,BPINS=+BPINS
- . . . F S BP59=+$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS,BP59)) Q:BP59=0 D
- . . . . S BPCNT=BPCNT+1
- . . . . S BPX=$P($$CLAIMST^BPSSCRU3(BP59),U)
- . . . . I BPX["E PAYABLE" S BPPB=BPPB+1 ;Payable
- . . . . I BPX["E REJECTED" S BPRJ=BPRJ+1 ;Rejected
- . . . . I BPX["E REVERSAL ACCEPTED" S BPACRV=BPACRV+1 ;Accepted Reversal
- . . . . I BPX["E REVERSAL REJECTED" S BPRJRV=BPRJRV+1 ;Rejected Reversal
- . . . . I $D(BP59) S BPELI=$$ELIGCODE^BPSSCR05($G(BP59))
- S BPX=$S($G(BPELI)="V":"VET",$G(BPELI)="T":"TRI",$G(BPELI)="C":"CVA",1:"Unk")
- ;
- I BPPB=BPCNT S BPX=BPX_" ALL payable"
- E S BPX=BPX_" Pb:"_BPPB_" Rj:"_BPRJ_" AcRv:"_BPACRV_" RjRv:"_BPRJRV
- Q BPX
- ;/**
- ;gets the patient summary information
- ;input:
- ; BPDFN - ptr to #2
- ; BPINS - insurance ien^insurance name^phone
- ;output:
- ; patient summary information
- PATINF(BPDFN,BPINS) ;*/
- N X,BPINSNM
- S BPINSNM=$P(BPINS,U,2)
- S X=$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN),13) ;name
- S X=X_" "_$$LJ($$SSN4^BPSSCRU2(BPDFN),6) ;4digits of SSN
- S X=X_" "_$$LJ($S(BPINSNM="":"????",1:BPINSNM),8) ;insurance
- S X=X_"/"_$$LJ($P(BPINS,U,3),14) ;phone
- Q X
- ;
- ;/**
- ;creates an entry in LM array and builds a non-standard index
- ;BPLMIND - passed by ref - current LM index - patient_AND_insurance level
- ;BPDRIND - passed by ref - current LM index - claim level
- ;BPTMP - VALMAR (TMP global for LM)
- ;BP59 - ptr to 9002313.59
- ;BPLINE - line number in LM ARRAY (by ref)
- ;BPSTR - string to save in ARRAY
- ;BPSINSUR - INSURANCE ien
- SAVEARR(BPTMP1,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR) ;
- S @BPTMP1@("LMIND",BPLMIND,BPDRIND,BPDFN,BPSINSUR,BP59,BPLINE)=""
- D SET^VALM10(BPLINE,BPSSTR,BP59)
- Q
- ;left justified, blank padded
- ;adds spaces on right or truncates to make return string BPLEN characters long
- ;BPST- original string
- ;BPLEN - desired length
- LJ(BPST,BPLEN) ;
- N BPL
- S BPL=BPLEN-$L(BPST)
- Q $E(BPST_$J("",$S(BPL<0:0,1:BPL)),1,BPLEN)
- ;
- ;right justified, blank padded
- ;adds spaces on left or truncates to make return string BPLEN characters long
- ;BPST- original string
- ;BPLEN - desired length
- RJ(BPST,BPLEN) ;
- S BPL=BPLEN-$L(BPST)
- I BPL>0 Q $J("",$S(BPL<0:0,1:BPL))_BPST
- Q $E(BPST,1,BPLEN)
- ;
- ;is the claim payable?
- PAYABLE(BP59) ;
- I $P($$CLAIMST^BPSSCRU3(BP59),U)["E PAYABLE" Q 1
- Q 0
- ;
- ;is the claim unstranded?
- UNSTRAND(BP59) ;
- I $P($$CLAIMST^BPSSCRU3(BP59),U)["E UNSTRANDED"!($P($$CLAIMST^BPSSCRU3(BP59),U)["E REVERSAL UNSTRANDED") Q 1
- Q 0
- ;
- ;is the claim rejected?
- REJECTED(BP59) ;
- I $P($$CLAIMST^BPSSCRU3(BP59),U)["E REJECTED" Q 1
- I $P($$CLAIMST^BPSSCRU3(BP59),U)["E REVERSAL REJECTED" Q 1
- Q 0
- ;update patient summary information for the previous patient/insurance pair
- UPDPREV(BPTMP,BPLMIND,BPPREV) ;
- N BPSSTR
- ;update the record for previous patient summary after we went thru all his claims
- S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND)
- D SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$P(BPPREV,U,3),0,+$P(BPPREV,U,2),BPSSTR,+$P(BPPREV,U,5))
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCR02 7933 printed Feb 18, 2025@23:19:26 Page 2
- BPSSCR02 ;BHAM ISC/SS - USER SCREEN UTILITIES ;05-APR-05
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,10,11**;JUN 2004;Build 27
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;USER SCREEN
- +4 ;
- REVERSE ;
- +1 NEW BPSDFN,BPSRX
- +2 DO SELECT(.BPSDFN,.BPSRX)
- +3 SET VALMBCK="R"
- +4 QUIT
- +5 ;
- SELECT(BPSDFN1,BPSRX1,BPSRF1,BPS59) ; Select a patient. Returns patient IEN(s) in array
- +1 NEW BPLN
- +2 SET BPLN=$$SELLINE("Select the line(s) with the paid claim(s) you wish to REVERSE","")
- +3 QUIT
- +4 ;
- SELLINE(BPSPROM,BPSDFVL) ;
- +1 NEW BPRET,DIR,X,Y,DIRUT
- +2 SET BPRET="^"
- +3 WRITE !
- SET DIR(0)="N^::2"
- SET DIR("A")=BPSPROM
- SET DIR("B")=BPSDFVL
- DO ^DIR
- IF $DATA(DIRUT)
- QUIT "^"
- +4 SET $PIECE(BPRET,U)=Y
- +5 QUIT BPRET
- +6 ;/**
- +7 ;make array element
- +8 ;BPLINE - line number in LM ARRAY (by ref)
- +9 ;BPTMP - VALMAR (TMP global for LM)
- +10 ;BP59 - ptr to 9002313.59
- +11 ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc)
- +12 ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... )
- +13 ;TMP structure gives on the screen:
- +14 ;^TMP("BPSSCR",$J,"VALM","LMIND",1,0,DFN,0,0)=
- +15 ;^TMP("BPSSCR",$J,"VALM",1,0)=1 BUMSTEAD,CHARLE (5444)/100-234-2345 *done* FINISHED
- +16 ;BPLINE = 1
- +17 ;BPLMIND=1
- +18 ;on the screen:
- +19 ;1 BUMSTEAD,CHARLE (5444) /100-234-2345 *done* FINISHED
- +20 ;
- +21 ;^TMP(538978189,"BPSSCR","SORT","T",1,401959.00001)=
- +22 ;^TMP("BPSSCR",$J,"VALM","LMIND",1,1,DFN,401959.00001,1)=
- +23 ;^TMP("BPSSCR",$J,"VALM",2,0)= 1.1 LOVASTATIN 20MG TAB
- +24 ;BPLINE = 2
- +25 ;BP59= 401959.00001
- +26 ;on the screen:
- +27 ; 1.1 LOVASTATIN 20MG TAB
- +28 ;
- +29 ;^TMP(538978189,"BPSSCR","SORT","T",1,501750.00011)=
- +30 ;^TMP("BPSSCR",$J,"VALM","LMIND",1,2,DFN,501750.00011,2)=
- +31 ;^TMP("BPSSCR",$J,"VALM",3,0)= 1.2 CIMETIDINE 300MG TAB
- +32 ;BPLINE = 3
- +33 ;BP59= 501750.00011
- +34 ;on the screen:
- +35 ; 1.2 CIMETIDINE 300MG TAB
- +36 ;
- MKARRELM(BPLINE,BPTMP,BP59,BPLMIND,BPDRIND,BPPREV) ;*/
- +1 NEW BPSSTR,BPLNS,BPDFN,BPSTAT,BPSINSUR,BPINSDAT
- +2 ;patient's DFN
- SET BPDFN=+$PIECE($GET(^BPST(BP59,0)),U,6)
- +3 SET BPINSDAT=$$GETINSUR^BPSSCRU2(BP59)
- +4 ;patient's insurance IEN
- SET BPSINSUR=+BPINSDAT
- +5 ;
- +6 ;PATIENT SUMMARY level
- +7 ; if last one was different DFN/INSURANCE combination then create a new Patient Summary level
- +8 IF (+$ORDER(@BPTMP@("LMIND",BPLMIND,0,0))'=BPDFN)!(+$ORDER(@BPTMP@("LMIND",BPLMIND,0,BPDFN,0))'=BPSINSUR)
- Begin DoDot:1
- +9 ;-------- first process previous patient & insurance group
- +10 ;determine patient summary statuses for the previous "patient" group
- +11 IF BPLMIND>0
- IF +BPPREV=BPLMIND
- Begin DoDot:2
- +12 ;update the record for previous patient summary after we went thru all his claims
- +13 DO UPDPREV(BPTMP,BPLMIND,BPPREV)
- End DoDot:2
- +14 ;process new "patient & insurance" group ------------------
- +15 SET BPDRIND=0
- +16 SET BPLMIND=(BPLMIND\1)+1
- +17 ;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on
- +18 SET BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF(BPDFN,BPINSDAT)_U_BPSINSUR
- +19 SET BPSSTR=$$LJ(BPLMIND,4)_$PIECE(BPPREV,U,4)
- +20 DO SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,BPSINSUR)
- +21 SET BPLINE=BPLINE+1
- End DoDot:1
- +22 ;
- +23 ;CLAIMS level
- +24 Begin DoDot:1
- +25 IF +$ORDER(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59
- Begin DoDot:2
- +26 SET BPDRIND=BPDRIND+1
- +27 SET BPSSTR=" "_$$LJ(+$PIECE(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF(BP59)
- +28 ;@debug,remove the next line after finish debugging
- +29 ;S BPSSTR=BPSSTR_" 59:"_BP59_" DT:"_$$TRANDT^BPSSCRU2(BP59)_" DFN:"_BPDFN_" INS:"_BPSINSUR
- +30 DO SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR)
- +31 SET BPLINE=BPLINE+1
- +32 NEW BPARR,X
- +33 SET BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"R")
- +34 FOR X=1:1:BPLNS
- Begin DoDot:3
- +35 IF $GET(BPARR(X))=""
- QUIT
- +36 DO SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR)
- +37 SET BPLINE=BPLINE+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +38 QUIT
- +39 ;S BPS=BPX
- +40 ;/**
- +41 ;BP59
- CLAIMINF(BP59) ;*/
- +1 NEW BPX,BPX1,DOSDT
- +2 SET BPX1=$$RXREF^BPSSCRU2(BP59)
- +3 SET BPX=$$LJ($$DRGNAME^BPSSCRU2(BP59),17)_" "_$$LJ($$NDC^BPSSCRU2(+BPX1,+$PIECE(BPX1,U,2)),11)_" "
- +4 ;
- +5 ;SLT - BPS*1.0*11
- +6 SET DOSDT=$$LASTDOS^BPSUTIL2(BP59,0)
- +7 ;
- +8 SET BPX=BPX_$$LJ(DOSDT,5)_" "
- +9 SET BPX=BPX_$$LJ($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$PIECE(BPX1,U,2)_"/"
- +10 SET BPX=BPX_$$LJ($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" "
- +11 SET BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59)
- +12 QUIT BPX
- +13 ;/**
- +14 ;determine "done" and "FINISHED" status for patient/insurance group by BPLMIND in TMP global
- STAT4PAT(BPLMIND) ;*/
- +1 NEW BPCL,BPDFN,BP59,BPX,BPINS,BPX,BPCNT,BPELI
- +2 NEW BPPB,BPRJ,BPACRV,BPRJRV,BPSR,BPFIN,BPPRCNTG
- +3 SET (BPCL,BPPB,BPRJ,BPACRV,BPSR,BPRJRV)=0
- +4 ; finished by default
- SET BPFIN=0
- +5 SET BPPRCNTG=0
- +6 SET BPCNT=0
- +7 FOR
- SET BPCL=+$ORDER(@BPTMP@("LMIND",BPLMIND,BPCL))
- if BPCL=0
- QUIT
- Begin DoDot:1
- +8 SET BPDFN=0
- +9 FOR
- SET BPDFN=+$ORDER(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN))
- if BPDFN=0
- QUIT
- Begin DoDot:2
- +10 ;can be 0 in the TMP global if insurance plan
- SET BPINS=""
- +11 ;is corrupted in file ##9002313.59
- +12 FOR
- SET BPINS=$ORDER(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS))
- if BPINS=""
- QUIT
- Begin DoDot:3
- +13 SET BP59=0
- SET BPINS=+BPINS
- +14 FOR
- SET BP59=+$ORDER(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS,BP59))
- if BP59=0
- QUIT
- Begin DoDot:4
- +15 SET BPCNT=BPCNT+1
- +16 SET BPX=$PIECE($$CLAIMST^BPSSCRU3(BP59),U)
- +17 ;Payable
- IF BPX["E PAYABLE"
- SET BPPB=BPPB+1
- +18 ;Rejected
- IF BPX["E REJECTED"
- SET BPRJ=BPRJ+1
- +19 ;Accepted Reversal
- IF BPX["E REVERSAL ACCEPTED"
- SET BPACRV=BPACRV+1
- +20 ;Rejected Reversal
- IF BPX["E REVERSAL REJECTED"
- SET BPRJRV=BPRJRV+1
- +21 IF $DATA(BP59)
- SET BPELI=$$ELIGCODE^BPSSCR05($GET(BP59))
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 SET BPX=$SELECT($GET(BPELI)="V":"VET",$GET(BPELI)="T":"TRI",$GET(BPELI)="C":"CVA",1:"Unk")
- +23 ;
- +24 IF BPPB=BPCNT
- SET BPX=BPX_" ALL payable"
- +25 IF '$TEST
- SET BPX=BPX_" Pb:"_BPPB_" Rj:"_BPRJ_" AcRv:"_BPACRV_" RjRv:"_BPRJRV
- +26 QUIT BPX
- +27 ;/**
- +28 ;gets the patient summary information
- +29 ;input:
- +30 ; BPDFN - ptr to #2
- +31 ; BPINS - insurance ien^insurance name^phone
- +32 ;output:
- +33 ; patient summary information
- PATINF(BPDFN,BPINS) ;*/
- +1 NEW X,BPINSNM
- +2 SET BPINSNM=$PIECE(BPINS,U,2)
- +3 ;name
- SET X=$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN),13)
- +4 ;4digits of SSN
- SET X=X_" "_$$LJ($$SSN4^BPSSCRU2(BPDFN),6)
- +5 ;insurance
- SET X=X_" "_$$LJ($SELECT(BPINSNM="":"????",1:BPINSNM),8)
- +6 ;phone
- SET X=X_"/"_$$LJ($PIECE(BPINS,U,3),14)
- +7 QUIT X
- +8 ;
- +9 ;/**
- +10 ;creates an entry in LM array and builds a non-standard index
- +11 ;BPLMIND - passed by ref - current LM index - patient_AND_insurance level
- +12 ;BPDRIND - passed by ref - current LM index - claim level
- +13 ;BPTMP - VALMAR (TMP global for LM)
- +14 ;BP59 - ptr to 9002313.59
- +15 ;BPLINE - line number in LM ARRAY (by ref)
- +16 ;BPSTR - string to save in ARRAY
- +17 ;BPSINSUR - INSURANCE ien
- SAVEARR(BPTMP1,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR) ;
- +1 SET @BPTMP1@("LMIND",BPLMIND,BPDRIND,BPDFN,BPSINSUR,BP59,BPLINE)=""
- +2 DO SET^VALM10(BPLINE,BPSSTR,BP59)
- +3 QUIT
- +4 ;left justified, blank padded
- +5 ;adds spaces on right or truncates to make return string BPLEN characters long
- +6 ;BPST- original string
- +7 ;BPLEN - desired length
- LJ(BPST,BPLEN) ;
- +1 NEW BPL
- +2 SET BPL=BPLEN-$LENGTH(BPST)
- +3 QUIT $EXTRACT(BPST_$JUSTIFY("",$SELECT(BPL<0:0,1:BPL)),1,BPLEN)
- +4 ;
- +5 ;right justified, blank padded
- +6 ;adds spaces on left or truncates to make return string BPLEN characters long
- +7 ;BPST- original string
- +8 ;BPLEN - desired length
- RJ(BPST,BPLEN) ;
- +1 SET BPL=BPLEN-$LENGTH(BPST)
- +2 IF BPL>0
- QUIT $JUSTIFY("",$SELECT(BPL<0:0,1:BPL))_BPST
- +3 QUIT $EXTRACT(BPST,1,BPLEN)
- +4 ;
- +5 ;is the claim payable?
- PAYABLE(BP59) ;
- +1 IF $PIECE($$CLAIMST^BPSSCRU3(BP59),U)["E PAYABLE"
- QUIT 1
- +2 QUIT 0
- +3 ;
- +4 ;is the claim unstranded?
- UNSTRAND(BP59) ;
- +1 IF $PIECE($$CLAIMST^BPSSCRU3(BP59),U)["E UNSTRANDED"!($PIECE($$CLAIMST^BPSSCRU3(BP59),U)["E REVERSAL UNSTRANDED")
- QUIT 1
- +2 QUIT 0
- +3 ;
- +4 ;is the claim rejected?
- REJECTED(BP59) ;
- +1 IF $PIECE($$CLAIMST^BPSSCRU3(BP59),U)["E REJECTED"
- QUIT 1
- +2 IF $PIECE($$CLAIMST^BPSSCRU3(BP59),U)["E REVERSAL REJECTED"
- QUIT 1
- +3 QUIT 0
- +4 ;update patient summary information for the previous patient/insurance pair
- UPDPREV(BPTMP,BPLMIND,BPPREV) ;
- +1 NEW BPSSTR
- +2 ;update the record for previous patient summary after we went thru all his claims
- +3 SET BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$PIECE(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND)
- +4 DO SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$PIECE(BPPREV,U,3),0,+$PIECE(BPPREV,U,2),BPSSTR,+$PIECE(BPPREV,U,5))
- +5 QUIT
- +6 ;