ABSPOSF ; IHS/FCS/DRS - Print NCPDP claim ; [ 09/12/2002 10:08 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;
; Directory of ABSPOSF* routines:
;
; ABSPOSF - main entry points
; ABSPOSFA - SORT and PRINT
; ABSPOSFB-ABSPOSFD - assemble ABSP() and NCPDP() arrays
; ABSPOSFP - the actual printing takes place here
; ABSPOSFX - details of the alignment (test print)
;
Q
PRINT ; EP - ; For printing forms at a site which doesn't have ILC A/R:
; Option name ABSP NCPDP FORMS PRINT
; prompt for a date range
; and "start at insurer"
; and "are you sure?"
N PROMPT1,PROMPT2,DEF1,DEF2
S PROMPT1="Starting with what transaction date? "
S PROMPT2=" Ending with what transaction date? "
S DEF1="",DEF2=""
W !!,"Print NCPDP Pharmacy Claim Forms",!!
N RANGE S RANGE=$$DTR^ABSPOSU1(PROMPT1,PROMPT2,DEF1,DEF2,1) W !
I 'RANGE Q
N X S X=$P(RANGE,U,2) ; go through end of last day, if no time given
I $P(X,".",2)="" S $P(X,".",2)=24,$P(RANGE,U,2)=X
;
; Start printing at what insurer?
;
N INSFIRST S INSFIRST=$$INSFIRST Q:"^^"[INSFIRST
;
; Build ^TMP("ABSPOSF",$J,1,ien57)=""
W !,"Now building a list of transactions for which to print forms...",!
K ^TMP("ABSPOSF",$J)
; Scan ^ABSPTL("AH",last update date-time,ien57)
N COUNT S COUNT=0
N WHEN S WHEN=$P(RANGE,U) ; start at the start time
F D Q:'WHEN Q:WHEN>$P(RANGE,U,2) ; scan thru the end time
. N IEN57 S IEN57=0
. F S IEN57=$O(^ABSPTL("AH",WHEN,IEN57)) Q:'IEN57 D
. . ; Include only transactions whose RESULT WITH REVERSAL = "PAPER"
. . Q:$$GET1^DIQ(9002313.57,IEN57_",","RESULT WITH REVERSAL")'="PAPER"
. . ; Exclude:
. . ; 1. No insurance
. . N INS S INS=$P(^ABSPTL(IEN57,1),U,6) Q:'INS
. . N INSNAME S INSNAME=$P($G(^AUTNINS(INS,0)),U) Q:INSNAME=""
. . ; 3. Insurance name comes before starting point
. . I INSFIRST]INSNAME Q
. . I $$UNINS^ABSPOSF(INSNAME) Q ;names like SELF PAY or UNINSURED
. . ; 2. Any with a subsequent transaction for the same ENTRY #
. . N RXIRXR S RXIRXR=$P(^ABSPTL(IEN57,0),U)
. . I $O(^ABSPTL("B",RXIRXR,IEN57)) Q
. . ; Succeeded: this transaction deserves a claim form
. . S ^TMP("ABSPOSF",$J,1,IEN57)=""
. . S COUNT=COUNT+1
. S WHEN=$O(^ABSPTL("AH",WHEN)) ; bump up to next transaction time
JOIN ; REPRINT joins here
W !,"Number of claims: ",COUNT,!
I 'COUNT Q
I COUNT>1 D
. W "Note: because some forms may have two claims on the same page,",!
. W "you might print fewer than ",COUNT," forms.",!
N X S X=$$YESNO^ABSPOSU3("Okay to proceed","",0)
I X'=1 D Q
. W !,"Nothing done.",!
D SORT^ABSPOSFA
D PRINT^ABSPOSFA
;
Q
ALIGN ;EP - align NCPDP forms
; Option name ABSP NCPDP FORMS ALIGN
W !,"Test print for NCPDP forms",!
N POP D ^%ZIS Q:$G(POP)
ALIGN1 U IO
D ALIGN^ABSPOSFX
U $P
I $$YESNO^ABSPOSU3("Print again","NO",1) G ALIGN1
D ^%ZISC
Q
REPRINT ;EP - reprint selected NCPDP forms
; Option name ABSP NCPDP FORMS REPRINT
W !!,"Reprint selected NCPDP forms",!!
W "First, select the patient(s).",!
N PATARRAY,PAT57,IEN57
F S PAT57=$$PAT57 Q:'PAT57 S PATARRAY(PAT57)=""
I '$O(PATARRAY("")) Q ; none selected
W !!,"Choose a transaction date or range of transaction dates",!
W "for which to reprint NCPDP forms for the selected patient(s).",!
N RANGE S RANGE=$$DTR^ABSPOSU1(PROMPT1,PROMPT2,DEF1,DEF2,1) W !
I 'RANGE Q
N X S X=$P(RANGE,U,2) ; go through end of last day, if no time given
I $P(X,".",2)="" S $P(X,".",2)=24,$P(RANGE,U,2)=X
W !,"Gathering the selected transactions..." S COUNT=0
N WHEN S WHEN=$P(RANGE,U)
F D Q:'WHEN Q:WHEN>$P(RANGE,U,2)
. S IEN57=0
. F S IEN57=$O(^ABSPTL("AH",WHEN,IEN57)) Q:'IEN57 D
. . S PAT57=$P(^ABSPTL(IEN57,0),U,6)
. . Q:'PAT57 Q:'$D(PATARRAY(PAT57))
. . S ^TMP("ABSPOSF",$J,1,IEN57)="",COUNT=COUNT+1
. S WHEN=$O(^ABSPTL("AH",WHEN))
N INSFIRST S INSFIRST=" "
G JOIN ; up above - to SORT and PRINT
PAT57() ; Lookup patient in 9002313.57 transactions
N DIC,X,DLAYGO,Y
S DIC=2,DIC(0)="AMQ"
S DIC("A")="Reprint for which patient?"
S DIC("S")="I $D(^ABSPTL(""AC"",Y)"
D ^DIC W !
I Y<0 Q $S($D(DTOUT):"^",$D(DUOUT):"^",1:"")
S Y=+Y
N IEN57 S IEN57=$O(^ABSPTL("AC",Y,0))
N DATE1 S DATE1=$P(^ABSPTL(IEN57,0),U,8)\1
S IEN57=$O(^ABSPTL("AC",Y,""),-1)
N DATE2 S DATE2=$P(^ABSPTL(IEN57,0),U,8)\1
W ?10,"Transaction date" I DATE1'=DATE2 W "s" W " "
S Y=DATE1 X ^DD("DD") W Y
I DATE1'=DATE2 S Y=DATE2 X ^DD("DD") W " - ",Y
W !
Q
ILCPRINT ; EP - ; For printing forms from ILC A/R pre-bill list
; Build ^TMP("ABSPOSF",$J,1,ien57)
W !,"Print NCPDP forms",!
N INSFIRST S INSFIRST=$$INSFIRST Q:"^^"[INSFIRST
I INSFIRST]" " D
. W !,"Note: if you answer YES to an ""Okay to update bills?"" question,",!
. W "later on in the ILC A/R system, it will update all the bills,",!
. W "not only the ones which were printed starting at ",INSFIRST,".",!
W !,"Gathering claims from the NCPDP Prebill List in the A/R system..."
K ^TMP("ABSPOSF",$J)
N PCNDFN S PCNDFN=0
; Loop through the ILC A/R Prebilling list for NCPDP forms:
F S PCNDFN=$O(^ABSBITMS(9002302,"APRX1",1,PCNDFN)) Q:'PCNDFN D
. I INSFIRST]" ",INSFIRST]$$ILCINSNM(PCNDFN) Q ; starting at later pt
. N IEN57 S IEN57=0
. F S IEN57=$O(^ABSPTL("C",PCNDFN,IEN57)) Q:'IEN57 D
. . S ^TMP("ABSPOSF",$J,1,IEN57)=""
W !
D SORT^ABSPOSFA
I '$$YESNO^ABSPOSU3("Okay to continue","",0) W !
D PRINT^ABSPOSFA
Q
INSFIRST() ; returns where to start printing or "" or "^" or "^^" to cancel
N RET
S RET=$$YESNO^ABSPOSU3("Print for all insurers","YES",0)
I RET=1 Q " " ; start at beginning, then
I RET'=0 Q RET ; back out
; No, don't start at beginning
S RET=$$FREETEXT^ABSPOSU2("Print forms alphabetically starting where"," ",1,1,30) W !
Q RET
ILCINS(PCNDFN) ; EP - get the ILC insurer IEN
N X S X=$P($G(^ABSBITMS(9002302,PCNDFN,0)),U,4) ; int. audit ins.
I 'X S X=1
I '$D(^ABSBITMS(9002302,PCNDFN,"INSCOV1",X,1)) Q
S X=$P(^ABSBITMS(9002302,PCNDFN,"INSCOV1",X,1),U,2)
I X S INSIEN=X
Q
ILCINSNM(PCNDFN) ; EP - get the ILC insurer name
Q $P(^ABSBITMS(9002302,PCNDFN,0),U,3) ; easy - AUDIT INSURER field
UNINS(NAME) ; EP - is it an uninsured kind of pseudo-insurance
I NAME?1"SELF".E Q 1
I NAME?1"UNINS".E Q 1
Q 0
ABSPOSF ; IHS/FCS/DRS - Print NCPDP claim ; [ 09/12/2002 10:08 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;
+4 ; Directory of ABSPOSF* routines:
+5 ;
+6 ; ABSPOSF - main entry points
+7 ; ABSPOSFA - SORT and PRINT
+8 ; ABSPOSFB-ABSPOSFD - assemble ABSP() and NCPDP() arrays
+9 ; ABSPOSFP - the actual printing takes place here
+10 ; ABSPOSFX - details of the alignment (test print)
+11 ;
+12 QUIT
PRINT ; EP - ; For printing forms at a site which doesn't have ILC A/R:
+1 ; Option name ABSP NCPDP FORMS PRINT
+2 ; prompt for a date range
+3 ; and "start at insurer"
+4 ; and "are you sure?"
+5 NEW PROMPT1,PROMPT2,DEF1,DEF2
+6 SET PROMPT1="Starting with what transaction date? "
+7 SET PROMPT2=" Ending with what transaction date? "
+8 SET DEF1=""
SET DEF2=""
+9 WRITE !!,"Print NCPDP Pharmacy Claim Forms",!!
+10 NEW RANGE
SET RANGE=$$DTR^ABSPOSU1(PROMPT1,PROMPT2,DEF1,DEF2,1)
WRITE !
+11 IF 'RANGE
QUIT
+12 ; go through end of last day, if no time given
NEW X
SET X=$PIECE(RANGE,U,2)
+13 IF $PIECE(X,".",2)=""
SET $PIECE(X,".",2)=24
SET $PIECE(RANGE,U,2)=X
+14 ;
+15 ; Start printing at what insurer?
+16 ;
+17 NEW INSFIRST
SET INSFIRST=$$INSFIRST
IF "^^"[INSFIRST
QUIT
+18 ;
+19 ; Build ^TMP("ABSPOSF",$J,1,ien57)=""
+20 WRITE !,"Now building a list of transactions for which to print forms...",!
+21 KILL ^TMP("ABSPOSF",$JOB)
+22 ; Scan ^ABSPTL("AH",last update date-time,ien57)
+23 NEW COUNT
SET COUNT=0
+24 ; start at the start time
NEW WHEN
SET WHEN=$PIECE(RANGE,U)
+25 ; scan thru the end time
FOR
Begin DoDot:1
+26 NEW IEN57
SET IEN57=0
+27 FOR
SET IEN57=$ORDER(^ABSPTL("AH",WHEN,IEN57))
IF 'IEN57
QUIT
Begin DoDot:2
+28 ; Include only transactions whose RESULT WITH REVERSAL = "PAPER"
+29 IF $$GET1^DIQ(9002313.57,IEN57_",","RESULT WITH REVERSAL")'="PAPER"
QUIT
+30 ; Exclude:
+31 ; 1. No insurance
+32 NEW INS
SET INS=$PIECE(^ABSPTL(IEN57,1),U,6)
IF 'INS
QUIT
+33 NEW INSNAME
SET INSNAME=$PIECE($GET(^AUTNINS(INS,0)),U)
IF INSNAME=""
QUIT
+34 ; 3. Insurance name comes before starting point
+35 IF INSFIRST]INSNAME
QUIT
+36 ;names like SELF PAY or UNINSURED
IF $$UNINS^ABSPOSF(INSNAME)
QUIT
+37 ; 2. Any with a subsequent transaction for the same ENTRY #
+38 NEW RXIRXR
SET RXIRXR=$PIECE(^ABSPTL(IEN57,0),U)
+39 IF $ORDER(^ABSPTL("B",RXIRXR,IEN57))
QUIT
+40 ; Succeeded: this transaction deserves a claim form
+41 SET ^TMP("ABSPOSF",$JOB,1,IEN57)=""
+42 SET COUNT=COUNT+1
End DoDot:2
+43 ; bump up to next transaction time
SET WHEN=$ORDER(^ABSPTL("AH",WHEN))
End DoDot:1
IF 'WHEN
QUIT
IF WHEN>$PIECE(RANGE,U,2)
QUIT
JOIN ; REPRINT joins here
+1 WRITE !,"Number of claims: ",COUNT,!
+2 IF 'COUNT
QUIT
+3 IF COUNT>1
Begin DoDot:1
+4 WRITE "Note: because some forms may have two claims on the same page,",!
+5 WRITE "you might print fewer than ",COUNT," forms.",!
End DoDot:1
+6 NEW X
SET X=$$YESNO^ABSPOSU3("Okay to proceed","",0)
+7 IF X'=1
Begin DoDot:1
+8 WRITE !,"Nothing done.",!
End DoDot:1
QUIT
+9 DO SORT^ABSPOSFA
+10 DO PRINT^ABSPOSFA
+11 ;
+12 QUIT
ALIGN ;EP - align NCPDP forms
+1 ; Option name ABSP NCPDP FORMS ALIGN
+2 WRITE !,"Test print for NCPDP forms",!
+3 NEW POP
DO ^%ZIS
IF $GET(POP)
QUIT
ALIGN1 USE IO
+1 DO ALIGN^ABSPOSFX
+2 USE $PRINCIPAL
+3 IF $$YESNO^ABSPOSU3("Print again","NO",1)
GOTO ALIGN1
+4 DO ^%ZISC
+5 QUIT
REPRINT ;EP - reprint selected NCPDP forms
+1 ; Option name ABSP NCPDP FORMS REPRINT
+2 WRITE !!,"Reprint selected NCPDP forms",!!
+3 WRITE "First, select the patient(s).",!
+4 NEW PATARRAY,PAT57,IEN57
+5 FOR
SET PAT57=$$PAT57
IF 'PAT57
QUIT
SET PATARRAY(PAT57)=""
+6 ; none selected
IF '$ORDER(PATARRAY(""))
QUIT
+7 WRITE !!,"Choose a transaction date or range of transaction dates",!
+8 WRITE "for which to reprint NCPDP forms for the selected patient(s).",!
+9 NEW RANGE
SET RANGE=$$DTR^ABSPOSU1(PROMPT1,PROMPT2,DEF1,DEF2,1)
WRITE !
+10 IF 'RANGE
QUIT
+11 ; go through end of last day, if no time given
NEW X
SET X=$PIECE(RANGE,U,2)
+12 IF $PIECE(X,".",2)=""
SET $PIECE(X,".",2)=24
SET $PIECE(RANGE,U,2)=X
+13 WRITE !,"Gathering the selected transactions..."
SET COUNT=0
+14 NEW WHEN
SET WHEN=$PIECE(RANGE,U)
+15 FOR
Begin DoDot:1
+16 SET IEN57=0
+17 FOR
SET IEN57=$ORDER(^ABSPTL("AH",WHEN,IEN57))
IF 'IEN57
QUIT
Begin DoDot:2
+18 SET PAT57=$PIECE(^ABSPTL(IEN57,0),U,6)
+19 IF 'PAT57
QUIT
IF '$DATA(PATARRAY(PAT57))
QUIT
+20 SET ^TMP("ABSPOSF",$JOB,1,IEN57)=""
SET COUNT=COUNT+1
End DoDot:2
+21 SET WHEN=$ORDER(^ABSPTL("AH",WHEN))
End DoDot:1
IF 'WHEN
QUIT
IF WHEN>$PIECE(RANGE,U,2)
QUIT
+22 NEW INSFIRST
SET INSFIRST=" "
+23 ; up above - to SORT and PRINT
GOTO JOIN
PAT57() ; Lookup patient in 9002313.57 transactions
+1 NEW DIC,X,DLAYGO,Y
+2 SET DIC=2
SET DIC(0)="AMQ"
+3 SET DIC("A")="Reprint for which patient?"
+4 SET DIC("S")="I $D(^ABSPTL(""AC"",Y)"
+5 DO ^DIC
WRITE !
+6 IF Y<0
QUIT $SELECT($DATA(DTOUT):"^",$DATA(DUOUT):"^",1:"")
+7 SET Y=+Y
+8 NEW IEN57
SET IEN57=$ORDER(^ABSPTL("AC",Y,0))
+9 NEW DATE1
SET DATE1=$PIECE(^ABSPTL(IEN57,0),U,8)\1
+10 SET IEN57=$ORDER(^ABSPTL("AC",Y,""),-1)
+11 NEW DATE2
SET DATE2=$PIECE(^ABSPTL(IEN57,0),U,8)\1
+12 WRITE ?10,"Transaction date"
IF DATE1'=DATE2
WRITE "s"
WRITE " "
+13 SET Y=DATE1
XECUTE ^DD("DD")
WRITE Y
+14 IF DATE1'=DATE2
SET Y=DATE2
XECUTE ^DD("DD")
WRITE " - ",Y
+15 WRITE !
+16 QUIT
ILCPRINT ; EP - ; For printing forms from ILC A/R pre-bill list
+1 ; Build ^TMP("ABSPOSF",$J,1,ien57)
+2 WRITE !,"Print NCPDP forms",!
+3 NEW INSFIRST
SET INSFIRST=$$INSFIRST
IF "^^"[INSFIRST
QUIT
+4 IF INSFIRST]" "
Begin DoDot:1
+5 WRITE !,"Note: if you answer YES to an ""Okay to update bills?"" question,",!
+6 WRITE "later on in the ILC A/R system, it will update all the bills,",!
+7 WRITE "not only the ones which were printed starting at ",INSFIRST,".",!
End DoDot:1
+8 WRITE !,"Gathering claims from the NCPDP Prebill List in the A/R system..."
+9 KILL ^TMP("ABSPOSF",$JOB)
+10 NEW PCNDFN
SET PCNDFN=0
+11 ; Loop through the ILC A/R Prebilling list for NCPDP forms:
+12 FOR
SET PCNDFN=$ORDER(^ABSBITMS(9002302,"APRX1",1,PCNDFN))
IF 'PCNDFN
QUIT
Begin DoDot:1
+13 ; starting at later pt
IF INSFIRST]" "
IF INSFIRST]$$ILCINSNM(PCNDFN)
QUIT
+14 NEW IEN57
SET IEN57=0
+15 FOR
SET IEN57=$ORDER(^ABSPTL("C",PCNDFN,IEN57))
IF 'IEN57
QUIT
Begin DoDot:2
+16 SET ^TMP("ABSPOSF",$JOB,1,IEN57)=""
End DoDot:2
End DoDot:1
+17 WRITE !
+18 DO SORT^ABSPOSFA
+19 IF '$$YESNO^ABSPOSU3("Okay to continue","",0)
WRITE !
+20 DO PRINT^ABSPOSFA
+21 QUIT
INSFIRST() ; returns where to start printing or "" or "^" or "^^" to cancel
+1 NEW RET
+2 SET RET=$$YESNO^ABSPOSU3("Print for all insurers","YES",0)
+3 ; start at beginning, then
IF RET=1
QUIT " "
+4 ; back out
IF RET'=0
QUIT RET
+5 ; No, don't start at beginning
+6 SET RET=$$FREETEXT^ABSPOSU2("Print forms alphabetically starting where"," ",1,1,30)
WRITE !
+7 QUIT RET
ILCINS(PCNDFN) ; EP - get the ILC insurer IEN
+1 ; int. audit ins.
NEW X
SET X=$PIECE($GET(^ABSBITMS(9002302,PCNDFN,0)),U,4)
+2 IF 'X
SET X=1
+3 IF '$DATA(^ABSBITMS(9002302,PCNDFN,"INSCOV1",X,1))
QUIT
+4 SET X=$PIECE(^ABSBITMS(9002302,PCNDFN,"INSCOV1",X,1),U,2)
+5 IF X
SET INSIEN=X
+6 QUIT
ILCINSNM(PCNDFN) ; EP - get the ILC insurer name
+1 ; easy - AUDIT INSURER field
QUIT $PIECE(^ABSBITMS(9002302,PCNDFN,0),U,3)
UNINS(NAME) ; EP - is it an uninsured kind of pseudo-insurance
+1 IF NAME?1"SELF".E
QUIT 1
+2 IF NAME?1"UNINS".E
QUIT 1
+3 QUIT 0
