ABSPOSMD ; IHS/FCS/DRS - General Inquiry/Report .57; [ 09/12/2002 10:14 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
Q
; Things which are one per page - does DHIT="W @IOF" work?
; that is, will you get the page header?
; Which would be nice to have as a standard transaction header.
;
ACTION ; EP - given ACTION = one of the codes for an action
; as selected from the list in ABSPOSMZ
; Also the ABSPOSMA() array is still there
; All of the EN1^DIP variables have been NEWed by the caller
I $T(@ACTION)="" D NOLABEL
N TEMPLATE,IENLIST
S IENLIST=$$IENLIST^ABSPOSMC
G @ACTION
DIP ; and each one rejoins here (G DIP) to set up for call to EN1^DIP
; with TEMPLATE=[template name]
K L,DIC,FLDS,BY,FR,TO,DHD,DIASKHD,DIPCRIT,PG,DHIT,DIOEND,DIOBEG
K DCOPIES,IOP,DQTIME,DIS,DISUPNO,DISTOP,DISPAR
S L=0
S DIC=9002313.57
S FLDS=TEMPLATE
S BY="@-NUMBER"
S FR=0
S TO=$O(@IENLIST@(""),-1)
I $D(TEMPLATE("HEADER")) D
. S DHD=TEMPLATE("HEADER")
. I $D(TEMPLATE("TRAILER")) S DHD=DHD_"-"_TEMPLATE("TRAILER")
; DIASKHD ; no, don't ask user
; DIPCRIT ; no, don't print sort criteria
; PG ; starting page number
; DHIT ; maybe formfeed for each new patient, for certain things?
I 1 D ; based on ACTION and ABSPOSMA(), maybe each claim on sep. page
. S DHIT="F Q:$Y+2'<IOSL W !"
; DIOEND
; DIOBEG
; DCOPIES
; IOP - prompt for device
; DQTIME
; DIS - no screens
; DISUPNO
S DISTOP="I 1"
;
S BY(0)=$$OPEN^ABSPOSMC(IENLIST)
S L(0)=1
;
D EN1^DIP
I ABSPOSMA("MODE")="INQUIRY" D PRESSANY^ABSPOSU5()
Q
TEMPLATE(TNAMESFX) ;
; Look for site-specific version of the print template.
; The template name ends in TNAMESFX.
; Otherwise, use the standard print template for TNAMESFX.
;
; Example: at tag S, xxxxx TRANSACTION SUMMARY
;
; If there's a site-specific version, a pointer to the template is at
; $P(^ABSP(9002313.99,1,"DIPT TRANSACTION SUMMARY"),U)
; and from that pointer, we can find the print template name.
; Such site-specific templates should be name spaced, but we don't
; enforce that here. We leave the naming as a local decision.
;
; Otherwise, we use the template named ABSP57 TRANSACTION SUMMARY
;
; Return value is the template name in [brackets]
;
N TNAME,TNUM
S TNUM=$P($G(^ABSP(9002313.99,1,"DIPT "_TNAMESFX)),U)
I TNUM S TNAME=$P($G(^DIPT(TNUM,0)),U)
E S TNAME=""
I TNAME="" S TNAME="ABSP57 "_TNAMESFX
; Make sure the template exists
S TNUM=$O(^DIPT("B",TNAME,0))
I 'TNUM D IMPOSS^ABSPOSUE("DB","TI","Missing print template "_TNAME,,"TEMPLATE",$T(+0))
S TNAME="["_TNAME_"]"
Q TNAME
TRANSHDR() ; $$ returns template name for transaction header
Q $$TEMPLATE("TRANSACTION HEADER")
;
S ; Transaction Summary ;
S TEMPLATE=$$TEMPLATE("TRANSACTION SUMMARY")
G DIP
C ; Claim - Basic info ;
S TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
S TEMPLATE=$$TEMPLATE("CLAIM BASIC INFO")
G DIP
R ; Response Detail
S TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
S TEMPLATE=$$TEMPLATE("RESPONSE INFO")
G DIP
F ; Financial Detail ; $$TEMPLATE("FINANCIAL DETAIL")
S TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
S TEMPLATE=$$TEMPLATE("FINANCIAL INFO")
G DIP
J ; Rejection Detail
S TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
S TEMPLATE=$$TEMPLATE("REJECT INFO")
G DIP
T ; Total Comprehensive Detail ; $$TEMPLATE("COMPREHENSIVE DETAIL")
D NOTIM("T")
G DIP
REC ; Summary Receipt ; $$TEMPLATE("SUMMARY RECEIPT")
D NOTIM("REC")
G DIP
D ; DUR Info Only ; $$TEMPLATE("DUR INFO ONLY")
S TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
S TEMPLATE=$$TEMPLATE("DUR INFO")
G DIP
PT ; Print Template selection ; Prompt user for a print template
; Let EN1^DIP do it. Just print instructions here to alert user
; as to what to do.
D NOTIM("PT")
G DIP
FM ; Fileman to customize output ; EN1^DIP will prompt user for fields
; to be printed.
D NOTIM("FM")
G DIP
NOLABEL(X) ;
D IMPOSS^ABSPOSUE("P","TI","Missing label "_X,,"NOLABEL",$T(+0))
Q
NOTIM(X) ;
D IMPOSS^ABSPOSUE("P","I","Not implemented at label "_X,,"NOTIM",$T(+0))
Q
ABSPOSMD ; IHS/FCS/DRS - General Inquiry/Report .57; [ 09/12/2002 10:14 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 QUIT
+3 ; Things which are one per page - does DHIT="W @IOF" work?
+4 ; that is, will you get the page header?
+5 ; Which would be nice to have as a standard transaction header.
+6 ;
ACTION ; EP - given ACTION = one of the codes for an action
+1 ; as selected from the list in ABSPOSMZ
+2 ; Also the ABSPOSMA() array is still there
+3 ; All of the EN1^DIP variables have been NEWed by the caller
+4 IF $TEXT(@ACTION)=""
DO NOLABEL
+5 NEW TEMPLATE,IENLIST
+6 SET IENLIST=$$IENLIST^ABSPOSMC
+7 GOTO @ACTION
DIP ; and each one rejoins here (G DIP) to set up for call to EN1^DIP
+1 ; with TEMPLATE=[template name]
+2 KILL L,DIC,FLDS,BY,FR,TO,DHD,DIASKHD,DIPCRIT,PG,DHIT,DIOEND,DIOBEG
+3 KILL DCOPIES,IOP,DQTIME,DIS,DISUPNO,DISTOP,DISPAR
+4 SET L=0
+5 SET DIC=9002313.57
+6 SET FLDS=TEMPLATE
+7 SET BY="@-NUMBER"
+8 SET FR=0
+9 SET TO=$ORDER(@IENLIST@(""),-1)
+10 IF $DATA(TEMPLATE("HEADER"))
Begin DoDot:1
+11 SET DHD=TEMPLATE("HEADER")
+12 IF $DATA(TEMPLATE("TRAILER"))
SET DHD=DHD_"-"_TEMPLATE("TRAILER")
End DoDot:1
+13 ; DIASKHD ; no, don't ask user
+14 ; DIPCRIT ; no, don't print sort criteria
+15 ; PG ; starting page number
+16 ; DHIT ; maybe formfeed for each new patient, for certain things?
+17 ; based on ACTION and ABSPOSMA(), maybe each claim on sep. page
IF 1
Begin DoDot:1
+18 SET DHIT="F Q:$Y+2'<IOSL W !"
End DoDot:1
+19 ; DIOEND
+20 ; DIOBEG
+21 ; DCOPIES
+22 ; IOP - prompt for device
+23 ; DQTIME
+24 ; DIS - no screens
+25 ; DISUPNO
+26 SET DISTOP="I 1"
+27 ;
+28 SET BY(0)=$$OPEN^ABSPOSMC(IENLIST)
+29 SET L(0)=1
+30 ;
+31 DO EN1^DIP
+32 IF ABSPOSMA("MODE")="INQUIRY"
DO PRESSANY^ABSPOSU5()
+33 QUIT
TEMPLATE(TNAMESFX) ;
+1 ; Look for site-specific version of the print template.
+2 ; The template name ends in TNAMESFX.
+3 ; Otherwise, use the standard print template for TNAMESFX.
+4 ;
+5 ; Example: at tag S, xxxxx TRANSACTION SUMMARY
+6 ;
+7 ; If there's a site-specific version, a pointer to the template is at
+8 ; $P(^ABSP(9002313.99,1,"DIPT TRANSACTION SUMMARY"),U)
+9 ; and from that pointer, we can find the print template name.
+10 ; Such site-specific templates should be name spaced, but we don't
+11 ; enforce that here. We leave the naming as a local decision.
+12 ;
+13 ; Otherwise, we use the template named ABSP57 TRANSACTION SUMMARY
+14 ;
+15 ; Return value is the template name in [brackets]
+16 ;
+17 NEW TNAME,TNUM
+18 SET TNUM=$PIECE($GET(^ABSP(9002313.99,1,"DIPT "_TNAMESFX)),U)
+19 IF TNUM
SET TNAME=$PIECE($GET(^DIPT(TNUM,0)),U)
+20 IF '$TEST
SET TNAME=""
+21 IF TNAME=""
SET TNAME="ABSP57 "_TNAMESFX
+22 ; Make sure the template exists
+23 SET TNUM=$ORDER(^DIPT("B",TNAME,0))
+24 IF 'TNUM
DO IMPOSS^ABSPOSUE("DB","TI","Missing print template "_TNAME,,"TEMPLATE",$TEXT(+0))
+25 SET TNAME="["_TNAME_"]"
+26 QUIT TNAME
TRANSHDR() ; $$ returns template name for transaction header
+1 QUIT $$TEMPLATE("TRANSACTION HEADER")
+2 ;
S ; Transaction Summary ;
+1 SET TEMPLATE=$$TEMPLATE("TRANSACTION SUMMARY")
+2 GOTO DIP
C ; Claim - Basic info ;
+1 SET TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
+2 SET TEMPLATE=$$TEMPLATE("CLAIM BASIC INFO")
+3 GOTO DIP
R ; Response Detail
+1 SET TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
+2 SET TEMPLATE=$$TEMPLATE("RESPONSE INFO")
+3 GOTO DIP
F ; Financial Detail ; $$TEMPLATE("FINANCIAL DETAIL")
+1 SET TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
+2 SET TEMPLATE=$$TEMPLATE("FINANCIAL INFO")
+3 GOTO DIP
J ; Rejection Detail
+1 SET TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
+2 SET TEMPLATE=$$TEMPLATE("REJECT INFO")
+3 GOTO DIP
T ; Total Comprehensive Detail ; $$TEMPLATE("COMPREHENSIVE DETAIL")
+1 DO NOTIM("T")
+2 GOTO DIP
REC ; Summary Receipt ; $$TEMPLATE("SUMMARY RECEIPT")
+1 DO NOTIM("REC")
+2 GOTO DIP
D ; DUR Info Only ; $$TEMPLATE("DUR INFO ONLY")
+1 SET TEMPLATE("HEADER")=$$TEMPLATE("TRANSACTION SUMMARY")
+2 SET TEMPLATE=$$TEMPLATE("DUR INFO")
+3 GOTO DIP
PT ; Print Template selection ; Prompt user for a print template
+1 ; Let EN1^DIP do it. Just print instructions here to alert user
+2 ; as to what to do.
+3 DO NOTIM("PT")
+4 GOTO DIP
FM ; Fileman to customize output ; EN1^DIP will prompt user for fields
+1 ; to be printed.
+2 DO NOTIM("FM")
+3 GOTO DIP
NOLABEL(X) ;
+1 DO IMPOSS^ABSPOSUE("P","TI","Missing label "_X,,"NOLABEL",$TEXT(+0))
+2 QUIT
NOTIM(X) ;
+1 DO IMPOSS^ABSPOSUE("P","I","Not implemented at label "_X,,"NOTIM",$TEXT(+0))
+2 QUIT
