- 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
