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
