ABSPOSQH.m

ABSPOSQH ; IHS/FCS/DRS - JWS 10:46 AM 7 Jan 1997 ;

 ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38

 ;prepare claims for transmission (eg assemble into ASCII record format)

 ; Called from ABSPOSQG, usually from ABSPOSQ2

 ; Also used by certification, called from ABSPOSC2

 ;

 ; You have CLAIMIEN(*), array of pointers to 9002313.02 claims

 ;

 ;Creates the following scratch global:

 ;   ^ABSPECX($J,"C",0) = <number of claims>

 ;   ^ABSPECX($J,"C",CLAIMIEN,0) = <number of nodes>

 ;   ^ABSPECX($J,"C",CLAIMIEN,1) = <ASCII record 1-245 chars>

 ;   ^ABSPECX($J,"C",CLAIMIEN,2) = <ASCII record 246-490 chars>

 ;                            N) = <..........................>

 ;----------------------------------------------------------------------

PASCII(DIALOUT) ;EP - from ABSPOSQG

 ;Manage local variables

 N AREC,COUNT

 S COUNT=0

 ;

 K ^ABSPECX($J,"C")

 ;

 ; Coming into this, ABS????? has 

 ; set up CLAIMIEN(*) = a list of CLAIMIENs that were generated from

 ; all the prescriptions that might have been bundled together.

 ; So we must loop through that list.

 S CLAIMIEN=""

 F  S CLAIMIEN=$O(CLAIMIEN(CLAIMIEN)) Q:CLAIMIEN=""  D PASCII1

 Q

 ;

PASCII1 ;EP - from above and also ABSPOSC2 ;

 ; Assemble NCPDP Ascii formatted record

 S AREC=$$ASCII^ABSPECA1(CLAIMIEN)

 Q:AREC=""

 ;

 ;Store NCPDP Ascii formatted record in ^ABSPECX($J,"C",CLAIMIEN,..)

 ;transmission scratch global

 N PREFIX S PREFIX=$P($G(^ABSP(9002313.55,DIALOUT,"NDC")),U,2)

 N ZERR  ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE

 ; If test mode for NDC, then change that prefix from HN* to HN.

 ; (Actually, I don't understand when or where that test mode really

 ;  means anything.)

 D SVEAREC^ABSPECX4(PREFIX_AREC,CLAIMIEN,"C") ;production mode

 ;

 ; And save a copy of the original transmitted record in

 ; ^ABSPC(CLAIMIEN,"M")

 N WP,I F I=1:100:$L(AREC) S WP(I/100+1,0)=$E(AREC,I,I+99)

 D WP^DIE(9002313.02,CLAIMIEN_",",9999,"","WP","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.

 I $D(ZERR) D LOG^ABSPOSL2("PASCII1^ABSPOSQH",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.

 ;

 ;Increment claim counter

 S COUNT=COUNT+1

 ;

 ;S ^ABSPECX($J,"C",0)=COUNT

 Q

ABSPOSQH  ; IHS/FCS/DRS - JWS 10:46 AM 7 Jan 1997 ;

 +1       ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38

 +2       ;prepare claims for transmission (eg assemble into ASCII record format)

 +3       ; Called from ABSPOSQG, usually from ABSPOSQ2

 +4       ; Also used by certification, called from ABSPOSC2

 +5       ;

 +6       ; You have CLAIMIEN(*), array of pointers to 9002313.02 claims

 +7       ;

 +8       ;Creates the following scratch global:

 +9       ;   ^ABSPECX($J,"C",0) = <number of claims>

 +10      ;   ^ABSPECX($J,"C",CLAIMIEN,0) = <number of nodes>

 +11      ;   ^ABSPECX($J,"C",CLAIMIEN,1) = <ASCII record 1-245 chars>

 +12      ;   ^ABSPECX($J,"C",CLAIMIEN,2) = <ASCII record 246-490 chars>

 +13      ;                            N) = <..........................>

 +14      ;----------------------------------------------------------------------

PASCII(DIALOUT) ;EP - from ABSPOSQG

 +1       ;Manage local variables

 +2        NEW AREC,COUNT

 +3        SET COUNT=0

 +4       ;

 +5        KILL ^ABSPECX($JOB,"C")

 +6       ;

 +7       ; Coming into this, ABS????? has 

 +8       ; set up CLAIMIEN(*) = a list of CLAIMIENs that were generated from

 +9       ; all the prescriptions that might have been bundled together.

 +10      ; So we must loop through that list.

 +11       SET CLAIMIEN=""

 +12       FOR 

               SET CLAIMIEN=$ORDER(CLAIMIEN(CLAIMIEN))

               IF CLAIMIEN=""

                   QUIT 

               DO PASCII1

 +13       QUIT 

 +14      ;

PASCII1   ;EP - from above and also ABSPOSC2 ;

 +1       ; Assemble NCPDP Ascii formatted record

 +2        SET AREC=$$ASCII^ABSPECA1(CLAIMIEN)

 +3        IF AREC=""

               QUIT 

 +4       ;

 +5       ;Store NCPDP Ascii formatted record in ^ABSPECX($J,"C",CLAIMIEN,..)

 +6       ;transmission scratch global

 +7        NEW PREFIX

           SET PREFIX=$PIECE($GET(^ABSP(9002313.55,DIALOUT,"NDC")),U,2)

 +8       ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE

           NEW ZERR

 +9       ; If test mode for NDC, then change that prefix from HN* to HN.

 +10      ; (Actually, I don't understand when or where that test mode really

 +11      ;  means anything.)

 +12      ;production mode

           DO SVEAREC^ABSPECX4(PREFIX_AREC,CLAIMIEN,"C")

 +13      ;

 +14      ; And save a copy of the original transmitted record in

 +15      ; ^ABSPC(CLAIMIEN,"M")

 +16       NEW WP,I

           FOR I=1:100:$LENGTH(AREC)

               SET WP(I/100+1,0)=$EXTRACT(AREC,I,I+99)

 +17      ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.

           DO WP^DIE(9002313.02,CLAIMIEN_",",9999,"","WP","ZERR")

 +18      ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.

           IF $DATA(ZERR)

               DO LOG^ABSPOSL2("PASCII1^ABSPOSQH",.ZERR)

 +19      ;

 +20      ;Increment claim counter

 +21       SET COUNT=COUNT+1

 +22      ;

 +23      ;S ^ABSPECX($J,"C",0)=COUNT

 +24       QUIT