- ABSPOSS2 ; IHS/FCS/DRS - ^ABSPEI printout,utils ;
- ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
- Q
- INUSE ;EP - ABSPOSS1
- D TEMPLATE("ABSP INSURERS")
- Q
- ANY(TYPE) ;EP - ABSPOSS1
- ; are there any records of relevance to be printed out?
- ; We want to avoid a whole page that says only "No records to print"
- I $D(ANY(TYPE)) Q ANY(TYPE) ; already figured this one out
- N FILE,FIELD,COND,IEN,IENS,RETVAL,X
- I TYPE="GRACE" S FILE=9002313.4,FIELD=100.08,COND="X]"""""
- E I TYPE="PREBILL"!(TYPE="NCPDP")!(TYPE="UN/BILLABLE") D
- . S FILE=9002313.4,COND="X=1"
- . I TYPE="PREBILL" S FIELD=105.99
- . E I TYPE="NCPDP" S FIELD=100.99
- . E I TYPE="UN/BILLABLE" S FIELD=2128.99
- . E D IMPOSS^ABSPOSUE("P","TI",9002313.4,,,$T(+0))
- . S COND="X=1"
- E I TYPE="USERS" D
- . S FILE=9002313.515,FIELD=.01,COND="X]"""""
- E I TYPE="WCOMP" D
- . S FILE=9002313.4,FIELD=107.01,COND="X]"""""
- E D IMPOSS^ABSPOSUE("P","TI","Bad TYPE="_TYPE,,"ANY",$T(+0)) Q
- ; Look for any record in 9002313.4 which meets condition
- S (IEN,RETVAL)=0
- I '$D(FILE) S FILE=9002313.4
- F S IEN=$$NEXT(IEN) Q:'IEN D Q:RETVAL
- . N MSG
- . S IENS=IEN_","
- . S X=$$GET1^DIQ(FILE,IENS,FIELD,"E",,"MSG")
- . I $D(MSG) D S RETVAL=-1 Q
- . . D ZWRITE^ABSPOS("FILE","IENS","FIELD","MSG")
- . . D IMPOSS^ABSPOSUE("FM","TI","$$GET1^DIQ failed",,"ANY",$T(+0))
- . S @("RETVAL="_COND)
- Q RETVAL
- NEXT(IEN) ;
- I FILE=9002313.4 Q $O(^ABSPEI(IEN))
- ; This FILE\1=9002313 trick won't work for every 9002313 file
- I FILE\1=9002313 Q $O(^ABSP(FILE,IEN))
- D IMPOSS^ABSPOSUE("P","TI","Bad value for FILE="_FILE,,"NEXT",$T(+0))
- Q ""
- TEMPLATE(TEMPLATE,FILE,PRINTTEM) ;EP - from ABSPOSS*
- N L,DIC,FLDS,BY,FR,TO,DIASKHD,DIPCRIT,PG,DHIT,DIOEND
- N DCOPIES,IOP,DQTIME,DIS,DISUPNO,DISTOP,DISPAR
- S L="",DIC=$S($D(FILE):FILE,1:9002313.4)
- I $D(TEMPLATE) D
- . S BY=TEMPLATE
- . S:'$D(PRINTTEM) PRINTTEM=TEMPLATE
- S BY="["_BY_"]",FLDS="["_PRINTTEM_"]"
- S (FR,TO)=""
- ; no - it doesn't seem to work the way we hoped it would
- ; S IOP=$I
- D EN1^DIP
- W !
- Q
- ABSPOSS2 ; IHS/FCS/DRS - ^ABSPEI printout,utils ;
- +1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
- +2 QUIT
- INUSE ;EP - ABSPOSS1
- +1 DO TEMPLATE("ABSP INSURERS")
- +2 QUIT
- ANY(TYPE) ;EP - ABSPOSS1
- +1 ; are there any records of relevance to be printed out?
- +2 ; We want to avoid a whole page that says only "No records to print"
- +3 ; already figured this one out
- IF $DATA(ANY(TYPE))
- QUIT ANY(TYPE)
- +4 NEW FILE,FIELD,COND,IEN,IENS,RETVAL,X
- +5 IF TYPE="GRACE"
- SET FILE=9002313.4
- SET FIELD=100.08
- SET COND="X]"""""
- +6 IF '$TEST
- IF TYPE="PREBILL"!(TYPE="NCPDP")!(TYPE="UN/BILLABLE")
- Begin DoDot:1
- +7 SET FILE=9002313.4
- SET COND="X=1"
- +8 IF TYPE="PREBILL"
- SET FIELD=105.99
- +9 IF '$TEST
- IF TYPE="NCPDP"
- SET FIELD=100.99
- +10 IF '$TEST
- IF TYPE="UN/BILLABLE"
- SET FIELD=2128.99
- +11 IF '$TEST
- DO IMPOSS^ABSPOSUE("P","TI",9002313.4,,,$TEXT(+0))
- +12 SET COND="X=1"
- End DoDot:1
- +13 IF '$TEST
- IF TYPE="USERS"
- Begin DoDot:1
- +14 SET FILE=9002313.515
- SET FIELD=.01
- SET COND="X]"""""
- End DoDot:1
- +15 IF '$TEST
- IF TYPE="WCOMP"
- Begin DoDot:1
- +16 SET FILE=9002313.4
- SET FIELD=107.01
- SET COND="X]"""""
- End DoDot:1
- +17 IF '$TEST
- DO IMPOSS^ABSPOSUE("P","TI","Bad TYPE="_TYPE,,"ANY",$TEXT(+0))
- QUIT
- +18 ; Look for any record in 9002313.4 which meets condition
- +19 SET (IEN,RETVAL)=0
- +20 IF '$DATA(FILE)
- SET FILE=9002313.4
- +21 FOR
- SET IEN=$$NEXT(IEN)
- IF 'IEN
- QUIT
- Begin DoDot:1
- +22 NEW MSG
- +23 SET IENS=IEN_","
- +24 SET X=$$GET1^DIQ(FILE,IENS,FIELD,"E",,"MSG")
- +25 IF $DATA(MSG)
- Begin DoDot:2
- +26 DO ZWRITE^ABSPOS("FILE","IENS","FIELD","MSG")
- +27 DO IMPOSS^ABSPOSUE("FM","TI","$$GET1^DIQ failed",,"ANY",$TEXT(+0))
- End DoDot:2
- SET RETVAL=-1
- QUIT
- +28 SET @("RETVAL="_COND)
- End DoDot:1
- IF RETVAL
- QUIT
- +29 QUIT RETVAL
- NEXT(IEN) ;
- +1 IF FILE=9002313.4
- QUIT $ORDER(^ABSPEI(IEN))
- +2 ; This FILE\1=9002313 trick won't work for every 9002313 file
- +3 IF FILE\1=9002313
- QUIT $ORDER(^ABSP(FILE,IEN))
- +4 DO IMPOSS^ABSPOSUE("P","TI","Bad value for FILE="_FILE,,"NEXT",$TEXT(+0))
- +5 QUIT ""
- TEMPLATE(TEMPLATE,FILE,PRINTTEM) ;EP - from ABSPOSS*
- +1 NEW L,DIC,FLDS,BY,FR,TO,DIASKHD,DIPCRIT,PG,DHIT,DIOEND
- +2 NEW DCOPIES,IOP,DQTIME,DIS,DISUPNO,DISTOP,DISPAR
- +3 SET L=""
- SET DIC=$SELECT($DATA(FILE):FILE,1:9002313.4)
- +4 IF $DATA(TEMPLATE)
- Begin DoDot:1
- +5 SET BY=TEMPLATE
- +6 IF '$DATA(PRINTTEM)
- SET PRINTTEM=TEMPLATE
- End DoDot:1
- +7 SET BY="["_BY_"]"
- SET FLDS="["_PRINTTEM_"]"
- +8 SET (FR,TO)=""
- +9 ; no - it doesn't seem to work the way we hoped it would
- +10 ; S IOP=$I
- +11 DO EN1^DIP
- +12 WRITE !
- +13 QUIT
