ABSPOSS1 ; IHS/FCS/DRS - report what's in POS tables ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001;Build 38
;
; Enter at top - option ABSP SETUP DETAIL
;
; ABSPOSS1 is for file 9002313.99 (SETUP)
; ABSPOSS2 is for file 9002313.4 (ABSP INSURER)
; and ABSPOSS7 too.
; ABSPOSS3 is for file 9002313.53 (PRICING)
; ABSPOSS4 is for file 9002313.54 (MODEM TYPES)
; ABSPOSS5 is for file 9002313.55 (DIAL OUT)
; ABSPOSS6 is for file 9002313.515 (USER PREFERENCES)
; and for file 9002313.56 (PHARMACIES)
; ABSPOSS8 has some specialized setup programs called from menus.
; ABSPOSS9 is an integrity check of selected items
N POP D ^%ZIS Q:$G(POP)
N REF S REF="^TMP("_$J_")"
N FILENUM
D REPORT^ABSPOSS9 ; integrity check
S FILENUM=9002313.99 D GET99(REF),PRINT99(REF)
Q
GET99(TARGET) N FILE,IENS,FIELD,FLAGS,MSG,ANY
S FILE=9002313.99
S IENS="1,"
S FIELD="**"
S FLAGS="EI"
D GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET,"MSG")
I $D(MSG) W "Problem in GET99^",$T(+0),! D ZWRITE^ABSPOS("MSG")
Q
DASHES N X S X=$J("",$S($G(IOM):IOM-1,1:79)),X=$TR(X," ","-") W X,! Q
SUBTITLE(X) W !,"----- ",X," -----",!! Q
SUBTITL2(X) W " ~ ",X," ~ ",! Q
TITLE(FILENUM) W !,"===== File ",FILENUM," ",$P(^DIC(FILENUM,0),U)," =====",!!
Q
EXPLAIN(X) W ?5,"(",X,")",! Q
ILCAR() Q $$ISILCAR^ABSPOSB ; is it ILC A/R (Version 1 or 2)?
IHS3PB() Q $$ISABMAR^ABSPOSB ; is it IHS 3rd Party Billing?
HEADING ;
W "Point of Sale - Detailed Configuration Report"
W ?60,$$NOWEXT^ABSPOSU1,!
W !
Q
PRINT99(REF) D HEADING
W $$VERSION^ABSPOS," ",$$VARIANT^ABSPOS,!
W "Shutdown flag = ",$$SHUTDOWN^ABSPOSQ3,!
W "Maximum transmitter/receiver jobs = ",$$MAXJOBS^ABSPOSQ3,!
D TITLE(FILENUM)
D FIELDS(FILENUM,.01)
D FIELDS(FILENUM,440.01) ; default dial-out
D FIELDS(FILENUM,170.01) ; A/R Package
;D FIELDS(FILENUM,.04)
;D FIELDS(FILENUM,2.01)
D SUBTITLE("Input settings")
D FIELDS(FILENUM,941)
D FIELDS(FILENUM,943)
D SUBTITLE("Miscellaneous insurance parameters")
D FIELDS(FILENUM,951)
I $G(@REF@(FILENUM,"1,",951,"I"))="" D
. D EXPLAIN("Grace period - the default default is 30 days")
. I $$ANY^ABSPOSS2("GRACE") D
. . D EXPLAIN("A list of insurers with grace period override")
. . D EXPLAIN(" appears later in this report.")
. E D
. . D EXPLAIN("All insurers are using the same grace period.")
I $$ANYINUSE^ABSPOSS8 D
. D EXPLAIN("A report of in-use insurance rules, if any, appears later in this report.")
D PRESSANY^ABSPOSU5() ; - - - - - - - - - - - - - - - - - - -
D SUBTITLE("Unbillable Items (system default settings)")
I $$ANY^ABSPOSS2("UN/BILLABLE") D
. D EXPLAIN("A list of insurers with specific settings for")
. D EXPLAIN("billable/unbillable items appears later in this report.")
D FIELDS(FILENUM,2128.13) ; OTC
D FIELDS(FILENUM,2128.11) ; NDC #
D FIELDS(FILENUM,2128.12) ; drug name
I '$$ILCAR G NOTILCAR ; but then the rest of this is ILC only
D SUBTITLE("Rules for Creating Accounts Receivable")
D FIELDS(FILENUM,170.01)
D EXPLAIN("Certain visit-related data is automatically filled in")
D EXPLAIN("at the time A/R is created. These SUPPRESS fields can")
D EXPLAIN("prevent such behavior.")
D FIELDS(FILENUM,370.01,370.99)
D EXPLAIN("The PREBILL fields control which forms are printed.")
D EXPLAIN("If not present, the default default to print NCPDP forms.")
D FIELDS(FILENUM,667.01,667.99)
I $$ANY^ABSPOSS2("PREBILL") D
. D EXPLAIN("A list of insurers with different prebill settings")
. D EXPLAIN(" appears later in this report.")
E D
. D EXPLAIN("All insurers are using these prebill settings.")
W !
D EXPLAIN("The A/R type assigned to new accounts can be set")
D EXPLAIN("to something else on a pharmacy basis.")
D FIELDS(FILENUM,1801) ; A/R TYPE
D SUBTITLE("Default parameters for printing NCPDP forms")
D FIELDS(FILENUM,665.01,665.04)
I $$ANY^ABSPOSS2("NCPDP") D
. D EXPLAIN("A list of insurers with changed settings for printing")
. D EXPLAIN(" NCPDP forms appears later in this report.")
E D
. D EXPLAIN("All insurers are using these NCPDP settings.")
; (Workers Comp in the original Sitka way)
;D SUBTITLE("Insurances to be used only for Workers Comp")
;D FIELDS(FILENUM+.0001,.01,.99)
D SUBTITLE("Insurers which lead to automatic writeoff")
D FIELDS(FILENUM+.002388,.01,.99)
D SUBTITLE("Beneficiary codes leading to auto-writeoff of SELF PAY")
D FIELDS(FILENUM+.002389,.01,.99)
D SUBTITLE("Special write-off rules; usually site-specific")
D FIELDS(FILENUM,2387.01,2387.99)
D SUBTITLE("Last time EOB screen input was done")
D FIELDS(FILENUM,577.01,577.99)
D SUBTITLE("Last time Writeoff screen input was done")
D FIELDS(FILENUM,2270.01,2270.99)
D SUBTITL2("For A/R types:")
D FIELDS(FILENUM+.002271,.01,.99)
D FIELDS(FILENUM,2272.01)
D SUBTITL2("For Clinics:")
D FIELDS(FILENUM+.002273,.01,.99)
D SUBTITL2("For Diagnoses:")
D FIELDS(FILENUM+.002274,.01,.99)
D SUBTITL2("For Insurers:")
D FIELDS(FILENUM+.002279,.01,.99)
NOTILCAR ; Branched here if not ILC A/R
D SUBTITLE("Miscellaneous other settings")
;D FIELDS(FILENUM,1490) ; NULL FILE
D FIELDS(FILENUM,1501) ; OUTSIDE LINE (what to dial to get one)
I $$ILCAR D FIELDS(FILENUM,1660.01) ; POSTAGE CPT
I $$ILCAR D FIELDS(FILENUM,1980.01,1980.99) ; STARTUP
W !
W "Also included in this report:",!
I $$ANYINUSE^ABSPOSS8 D
. W " A printout of insurance selection rules.",!
F FILE=9002313.56:-.01:9002313.53 D
. W " A printout of file ",FILE,": ",$P(^DIC(FILE,0),U),!
S FILE=9002313.515 I $$ANY^ABSPOSS2("USERS") D
. W " A printout of file ",FILE,": ",$P(^DIC(FILE,0),U),!
E D
. W " (There are no specific settings for individual users.)",!
I $$ANYINUSE^ABSPOSS8 D RPTINUSE^ABSPOSS8 ; insurance selection rules
I $$ANY^ABSPOSS2("GRACE") D TEMPLATE^ABSPOSS2("ABSP GRACE")
I $$ANY^ABSPOSS2("PREBILL") D TEMPLATE^ABSPOSS2("ABSP PREBILL")
I $$ANY^ABSPOSS2("NCPDP") D TEMPLATE^ABSPOSS2("ABSP NCPDP")
I $$ANY^ABSPOSS2("UN/BILLABLE") D TEMPLATE^ABSPOSS2("ABSP UN/BILLABLE")
I $$ANY^ABSPOSS2("WCOMP") D TEMPLATE^ABSPOSS2("ABSP WORKERS COMP")
D PHARMACY^ABSPOSS6 ; 9002313.56 PHARMACIES
D ABSPOSS1^ABSPOSS5 ; 9002313.55 DIAL OUT
D ABSPOSS1^ABSPOSS4 ; 9002313.54 MODEM TYPES
D ABSPOSS1^ABSPOSS3 ; 9002313.53 PRICING
I $$ANY^ABSPOSS2("USERS") D ABSPOSS1^ABSPOSS6 ; 9002313.515 USER SETS
D INUSE^ABSPOSS2 ; 9002313.4 ABSP INSURERs set up for e-claims
Q
FIELDS(FILENUM,LOW,HIGH) ;
I '$D(HIGH) S HIGH=LOW
N IENS S IENS=$O(@REF@(FILENUM,""))
I IENS="" D Q
. W "<no entries>",!
N ONLYONE S ONLYONE=($O(@REF@(FILENUM,IENS))="")
F D S IENS=$O(@REF@(FILENUM,IENS)) Q:IENS=""
. N F S F=LOW
. I '$D(^DD(FILENUM,F)) S F=$O(^DD(FILENUM,F)) ; be sure 1st one's def
. I 'F D Q ; no fields in this range?
. . W "<no fields in file ",FILENUM," range ",LOW,"-",HIGH," ?!>",!
. F D S F=$O(^DD(FILENUM,F)) Q:F>HIGH!'F
. . N FNAME I $D(^DD(FILENUM,F,0)) S FNAME=$P(^(0),U)
. . E S FNAME="<field #"_F_" undefined?!>"
. . N IVALUE S IVALUE=$G(@REF@(FILENUM,IENS,F,"I"))
. . N EVALUE S EVALUE=$G(@REF@(FILENUM,IENS,F,"E"))
. . I 'ONLYONE W IENS," "
. . I ONLYONE,F=.01 ; don't print field number & name if only .01
. . E D
. . . N X,Y S X=$J(F\1,5),Y=F#1 I 'Y S Y=""
. . . F Q:$L(Y)'<3 S Y=Y_" "
. . . W X,Y," "
. . . W FNAME,": "
. . W IVALUE
. . I IVALUE'=EVALUE W " (",EVALUE,")"
. . W !
Q
ABSPOSS1 ; IHS/FCS/DRS - report what's in POS tables ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001;Build 38
+2 ;
+3 ; Enter at top - option ABSP SETUP DETAIL
+4 ;
+5 ; ABSPOSS1 is for file 9002313.99 (SETUP)
+6 ; ABSPOSS2 is for file 9002313.4 (ABSP INSURER)
+7 ; and ABSPOSS7 too.
+8 ; ABSPOSS3 is for file 9002313.53 (PRICING)
+9 ; ABSPOSS4 is for file 9002313.54 (MODEM TYPES)
+10 ; ABSPOSS5 is for file 9002313.55 (DIAL OUT)
+11 ; ABSPOSS6 is for file 9002313.515 (USER PREFERENCES)
+12 ; and for file 9002313.56 (PHARMACIES)
+13 ; ABSPOSS8 has some specialized setup programs called from menus.
+14 ; ABSPOSS9 is an integrity check of selected items
+15 NEW POP
DO ^%ZIS
IF $GET(POP)
QUIT
+16 NEW REF
SET REF="^TMP("_$JOB_")"
+17 NEW FILENUM
+18 ; integrity check
DO REPORT^ABSPOSS9
+19 SET FILENUM=9002313.99
DO GET99(REF)
DO PRINT99(REF)
+20 QUIT
GET99(TARGET) NEW FILE,IENS,FIELD,FLAGS,MSG,ANY
+1 SET FILE=9002313.99
+2 SET IENS="1,"
+3 SET FIELD="**"
+4 SET FLAGS="EI"
+5 DO GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET,"MSG")
+6 IF $DATA(MSG)
WRITE "Problem in GET99^",$TEXT(+0),!
DO ZWRITE^ABSPOS("MSG")
+7 QUIT
DASHES NEW X
SET X=$JUSTIFY("",$SELECT($GET(IOM):IOM-1,1:79))
SET X=$TRANSLATE(X," ","-")
WRITE X,!
QUIT
SUBTITLE(X) WRITE !,"----- ",X," -----",!!
QUIT
SUBTITL2(X) WRITE " ~ ",X," ~ ",!
QUIT
TITLE(FILENUM) WRITE !,"===== File ",FILENUM," ",$PIECE(^DIC(FILENUM,0),U)," =====",!!
+1 QUIT
EXPLAIN(X) WRITE ?5,"(",X,")",!
QUIT
ILCAR() ; is it ILC A/R (Version 1 or 2)?
QUIT $$ISILCAR^ABSPOSB
IHS3PB() ; is it IHS 3rd Party Billing?
QUIT $$ISABMAR^ABSPOSB
HEADING ;
+1 WRITE "Point of Sale - Detailed Configuration Report"
+2 WRITE ?60,$$NOWEXT^ABSPOSU1,!
+3 WRITE !
+4 QUIT
PRINT99(REF) DO HEADING
+1 WRITE $$VERSION^ABSPOS," ",$$VARIANT^ABSPOS,!
+2 WRITE "Shutdown flag = ",$$SHUTDOWN^ABSPOSQ3,!
+3 WRITE "Maximum transmitter/receiver jobs = ",$$MAXJOBS^ABSPOSQ3,!
+4 DO TITLE(FILENUM)
+5 DO FIELDS(FILENUM,.01)
+6 ; default dial-out
DO FIELDS(FILENUM,440.01)
+7 ; A/R Package
DO FIELDS(FILENUM,170.01)
+8 ;D FIELDS(FILENUM,.04)
+9 ;D FIELDS(FILENUM,2.01)
+10 DO SUBTITLE("Input settings")
+11 DO FIELDS(FILENUM,941)
+12 DO FIELDS(FILENUM,943)
+13 DO SUBTITLE("Miscellaneous insurance parameters")
+14 DO FIELDS(FILENUM,951)
+15 IF $GET(@REF@(FILENUM,"1,",951,"I"))=""
Begin DoDot:1
+16 DO EXPLAIN("Grace period - the default default is 30 days")
+17 IF $$ANY^ABSPOSS2("GRACE")
Begin DoDot:2
+18 DO EXPLAIN("A list of insurers with grace period override")
+19 DO EXPLAIN(" appears later in this report.")
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 DO EXPLAIN("All insurers are using the same grace period.")
End DoDot:2
End DoDot:1
+22 IF $$ANYINUSE^ABSPOSS8
Begin DoDot:1
+23 DO EXPLAIN("A report of in-use insurance rules, if any, appears later in this report.")
End DoDot:1
+24 ; - - - - - - - - - - - - - - - - - - -
DO PRESSANY^ABSPOSU5()
+25 DO SUBTITLE("Unbillable Items (system default settings)")
+26 IF $$ANY^ABSPOSS2("UN/BILLABLE")
Begin DoDot:1
+27 DO EXPLAIN("A list of insurers with specific settings for")
+28 DO EXPLAIN("billable/unbillable items appears later in this report.")
End DoDot:1
+29 ; OTC
DO FIELDS(FILENUM,2128.13)
+30 ; NDC #
DO FIELDS(FILENUM,2128.11)
+31 ; drug name
DO FIELDS(FILENUM,2128.12)
+32 ; but then the rest of this is ILC only
IF '$$ILCAR
GOTO NOTILCAR
+33 DO SUBTITLE("Rules for Creating Accounts Receivable")
+34 DO FIELDS(FILENUM,170.01)
+35 DO EXPLAIN("Certain visit-related data is automatically filled in")
+36 DO EXPLAIN("at the time A/R is created. These SUPPRESS fields can")
+37 DO EXPLAIN("prevent such behavior.")
+38 DO FIELDS(FILENUM,370.01,370.99)
+39 DO EXPLAIN("The PREBILL fields control which forms are printed.")
+40 DO EXPLAIN("If not present, the default default to print NCPDP forms.")
+41 DO FIELDS(FILENUM,667.01,667.99)
+42 IF $$ANY^ABSPOSS2("PREBILL")
Begin DoDot:1
+43 DO EXPLAIN("A list of insurers with different prebill settings")
+44 DO EXPLAIN(" appears later in this report.")
End DoDot:1
+45 IF '$TEST
Begin DoDot:1
+46 DO EXPLAIN("All insurers are using these prebill settings.")
End DoDot:1
+47 WRITE !
+48 DO EXPLAIN("The A/R type assigned to new accounts can be set")
+49 DO EXPLAIN("to something else on a pharmacy basis.")
+50 ; A/R TYPE
DO FIELDS(FILENUM,1801)
+51 DO SUBTITLE("Default parameters for printing NCPDP forms")
+52 DO FIELDS(FILENUM,665.01,665.04)
+53 IF $$ANY^ABSPOSS2("NCPDP")
Begin DoDot:1
+54 DO EXPLAIN("A list of insurers with changed settings for printing")
+55 DO EXPLAIN(" NCPDP forms appears later in this report.")
End DoDot:1
+56 IF '$TEST
Begin DoDot:1
+57 DO EXPLAIN("All insurers are using these NCPDP settings.")
End DoDot:1
+58 ; (Workers Comp in the original Sitka way)
+59 ;D SUBTITLE("Insurances to be used only for Workers Comp")
+60 ;D FIELDS(FILENUM+.0001,.01,.99)
+61 DO SUBTITLE("Insurers which lead to automatic writeoff")
+62 DO FIELDS(FILENUM+.002388,.01,.99)
+63 DO SUBTITLE("Beneficiary codes leading to auto-writeoff of SELF PAY")
+64 DO FIELDS(FILENUM+.002389,.01,.99)
+65 DO SUBTITLE("Special write-off rules; usually site-specific")
+66 DO FIELDS(FILENUM,2387.01,2387.99)
+67 DO SUBTITLE("Last time EOB screen input was done")
+68 DO FIELDS(FILENUM,577.01,577.99)
+69 DO SUBTITLE("Last time Writeoff screen input was done")
+70 DO FIELDS(FILENUM,2270.01,2270.99)
+71 DO SUBTITL2("For A/R types:")
+72 DO FIELDS(FILENUM+.002271,.01,.99)
+73 DO FIELDS(FILENUM,2272.01)
+74 DO SUBTITL2("For Clinics:")
+75 DO FIELDS(FILENUM+.002273,.01,.99)
+76 DO SUBTITL2("For Diagnoses:")
+77 DO FIELDS(FILENUM+.002274,.01,.99)
+78 DO SUBTITL2("For Insurers:")
+79 DO FIELDS(FILENUM+.002279,.01,.99)
NOTILCAR ; Branched here if not ILC A/R
+1 DO SUBTITLE("Miscellaneous other settings")
+2 ;D FIELDS(FILENUM,1490) ; NULL FILE
+3 ; OUTSIDE LINE (what to dial to get one)
DO FIELDS(FILENUM,1501)
+4 ; POSTAGE CPT
IF $$ILCAR
DO FIELDS(FILENUM,1660.01)
+5 ; STARTUP
IF $$ILCAR
DO FIELDS(FILENUM,1980.01,1980.99)
+6 WRITE !
+7 WRITE "Also included in this report:",!
+8 IF $$ANYINUSE^ABSPOSS8
Begin DoDot:1
+9 WRITE " A printout of insurance selection rules.",!
End DoDot:1
+10 FOR FILE=9002313.56:-.01:9002313.53
Begin DoDot:1
+11 WRITE " A printout of file ",FILE,": ",$PIECE(^DIC(FILE,0),U),!
End DoDot:1
+12 SET FILE=9002313.515
IF $$ANY^ABSPOSS2("USERS")
Begin DoDot:1
+13 WRITE " A printout of file ",FILE,": ",$PIECE(^DIC(FILE,0),U),!
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 WRITE " (There are no specific settings for individual users.)",!
End DoDot:1
+16 ; insurance selection rules
IF $$ANYINUSE^ABSPOSS8
DO RPTINUSE^ABSPOSS8
+17 IF $$ANY^ABSPOSS2("GRACE")
DO TEMPLATE^ABSPOSS2("ABSP GRACE")
+18 IF $$ANY^ABSPOSS2("PREBILL")
DO TEMPLATE^ABSPOSS2("ABSP PREBILL")
+19 IF $$ANY^ABSPOSS2("NCPDP")
DO TEMPLATE^ABSPOSS2("ABSP NCPDP")
+20 IF $$ANY^ABSPOSS2("UN/BILLABLE")
DO TEMPLATE^ABSPOSS2("ABSP UN/BILLABLE")
+21 IF $$ANY^ABSPOSS2("WCOMP")
DO TEMPLATE^ABSPOSS2("ABSP WORKERS COMP")
+22 ; 9002313.56 PHARMACIES
DO PHARMACY^ABSPOSS6
+23 ; 9002313.55 DIAL OUT
DO ABSPOSS1^ABSPOSS5
+24 ; 9002313.54 MODEM TYPES
DO ABSPOSS1^ABSPOSS4
+25 ; 9002313.53 PRICING
DO ABSPOSS1^ABSPOSS3
+26 ; 9002313.515 USER SETS
IF $$ANY^ABSPOSS2("USERS")
DO ABSPOSS1^ABSPOSS6
+27 ; 9002313.4 ABSP INSURERs set up for e-claims
DO INUSE^ABSPOSS2
+28 QUIT
FIELDS(FILENUM,LOW,HIGH) ;
+1 IF '$DATA(HIGH)
SET HIGH=LOW
+2 NEW IENS
SET IENS=$ORDER(@REF@(FILENUM,""))
+3 IF IENS=""
Begin DoDot:1
+4 WRITE "<no entries>",!
End DoDot:1
QUIT
+5 NEW ONLYONE
SET ONLYONE=($ORDER(@REF@(FILENUM,IENS))="")
+6 FOR
Begin DoDot:1
+7 NEW F
SET F=LOW
+8 ; be sure 1st one's def
IF '$DATA(^DD(FILENUM,F))
SET F=$ORDER(^DD(FILENUM,F))
+9 ; no fields in this range?
IF 'F
Begin DoDot:2
+10 WRITE "<no fields in file ",FILENUM," range ",LOW,"-",HIGH," ?!>",!
End DoDot:2
QUIT
+11 FOR
Begin DoDot:2
+12 NEW FNAME
IF $DATA(^DD(FILENUM,F,0))
SET FNAME=$PIECE(^(0),U)
+13 IF '$TEST
SET FNAME="<field #"_F_" undefined?!>"
+14 NEW IVALUE
SET IVALUE=$GET(@REF@(FILENUM,IENS,F,"I"))
+15 NEW EVALUE
SET EVALUE=$GET(@REF@(FILENUM,IENS,F,"E"))
+16 IF 'ONLYONE
WRITE IENS," "
+17 ; don't print field number & name if only .01
IF ONLYONE
IF F=.01
+18 IF '$TEST
Begin DoDot:3
+19 NEW X,Y
SET X=$JUSTIFY(F\1,5)
SET Y=F#1
IF 'Y
SET Y=""
+20 FOR
IF $LENGTH(Y)'<3
QUIT
SET Y=Y_" "
+21 WRITE X,Y," "
+22 WRITE FNAME,": "
End DoDot:3
+23 WRITE IVALUE
+24 IF IVALUE'=EVALUE
WRITE " (",EVALUE,")"
+25 WRITE !
End DoDot:2
SET F=$ORDER(^DD(FILENUM,F))
IF F>HIGH!'F
QUIT
End DoDot:1
SET IENS=$ORDER(@REF@(FILENUM,IENS))
IF IENS=""
QUIT
+26 QUIT
