ABSPOSC1 ; IHS/FCS/DRS - certification testing ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
Q
;
; DEVELOPMENT USE ONLY!!! For use when doing certification testing.
; (Envoy, PCS, etc.)
;
; The format has to be in 9002313.92, with NDC BIN number and
; Envoy plan number filled in.
; Need to have ^ABSPEI(insurer,100) pointing to the format
; The insurer comes from $P(^ABSPC(n,0),U,2)
; Point the insurer to the RESERVED - FOR TESTING dial out.
;
; Have to set up an entry in 9002313.31. Fill in values for
; each of the NCPDP data dictionary fields for the test claim.
; In general, DON'T fill in 101 BIN Number. It will pick up the
; Envoy plan number from the 9002313.92 record for you.
;
; Once, before doing any of these,
;
; DO SETINSUR^ABSPOSC1(low,high pointer to 9002313.31)
; It prompts for insurer and sets the right insurer into each of
; those .31 records.
;
; ABSP INSURER file - ABSP SETUP INSURER QUICK to attach it to
; the format you're testing.
;
; DO SETDATE^ABSPOSC1(date,low,high pointer to 9002313.31)
;
;
; Then, to test an individual claim:
;
; DO TEST^ABSPOSC2(pointer to 9002313.31)
; But if you're doing a Reversal,
; instead DO REVERSAL^ABSPOSC2(pointer to 9002313.31)
; Temporarily uncomment the line in RXI4REV^ABSPOSU
;
; DO SEND^ABSPOSC2(pointer to 9002313.31) to transmit
;
; DO LOG^ABSPOSC2 to invoke ABSP COMMS LOG
; RESERVED - FOR TESTING is dial out `5 (saves typing!)
;
; DO PRINT^ABSPOSC2(pointer to 9002313.31) to dump raw claim
; and response packets
; DO PRINTR^ABSPOSC2(pointer to 9002313.31) to dump response only
;
; Use Fileman to print 9002313.02, .03 fields' contents.
; DO ^%G on ^ABSPC(entry # to look at fields that
; way, especially the trailing spaces.
;
; When there's multiple test claims to send, and the data varies
; just a little bit, use fileman Transfer Entries, then Enter/Edit
; to change the few that need to be changed.
;
Q
; Utilities to operate on lots of claims at once:
SETDATE(DATE,LOW,HIGH) ; Set DATE FILLED,DATE WRITTEN fields
; to the given date ; DT is a good choice for parameter 1!
N CLAIM,FIELD
I '$G(DATE) S DATE=DT
F CLAIM=LOW:1:HIGH F FIELD=401,414 D SETFIELD(CLAIM,FIELD,DATE)
Q
SETINSUR(LOW,HIGH) ;
N DIC,X,DTIME,DLAYGO,DINUM,Y,DTOUT,DUOUT
S DIC="^AUTNINS(",DIC(0)="AEMN" D ^DIC Q:Y<1 S Y=+Y
F CLAIM=LOW:1:HIGH D SET0(CLAIM,4,Y)
Q
SET0(CLAIM,PIECE,VALUE) ; set given piece of 0 node of 9002313.31 entry
Q:'$D(^ABSP(9002313.31,CLAIM))
S X=^ABSP(9002313.31,CLAIM,0)
N REF S REF="^ABSP(9002313.31,"_CLAIM_",0)" ;=$ZR
S ^TMP("ABSP",$J,"ABSPOSC1",DT,REF)=X ; save old values, just in case
S $P(X,U,PIECE)=Y
S ^ABSP(9002313.31,CLAIM,0)=X
W "Done for `",CLAIM,": ",X,!
Q
SETFIELD(CLAIM,FIELD,VALUE) ; general - set NCPDP field # value for given
; entry in 9002313.31 ; both in claim header and prescription detail
N M,N S M=0
F S M=$O(^ABSP(9002313.31,CLAIM,1,M)) Q:'M D ; claim header loop
. N X S X=^ABSP(9002313.31,CLAIM,1,M,0)
. S REF="^ABSP(9002313.31,"_CLAIM_",1,"_M_",0)" ;,REF=$ZR
. D SETF1
S N=0 F S N=$O(^ABSP(9002313.31,CLAIM,2,N)) Q:'N D ; presc loop
. N M S M=0
. F S M=$O(^ABSP(9002313.31,CLAIM,2,N,1,M)) Q:'M D ; field in presc
. . N X S X=^ABSP(9002313.31,CLAIM,2,N,1,M,0)
. . S REF="^ABSP(9002313.31,"_CLAIM_",2,"_N_",1,"_M_",0)" ;,REF=$ZR
. . D SETF1
Q
SETF1 ; given REF, X, FIELD, VALUE
I REF'?1"^ABSP(9002313.31,".E D Q ; safety!!!
. D IMPOSS^ABSPOSUE("P","T","Bad global REF="_REF,,"SETF1",$T(+0))
N F S F=$P(X,U) ; pointer to 9002313.91
N Y S Y=^ABSPF(9002313.91,F,0)
I $P(Y,U)'=FIELD Q ; match on NCPDP Field #
S ^TMP("ABSP",$J,"ABSPOSC1",DT,REF)=X ; save old value of node
S $P(X,U,2)=VALUE ; replace it with the new value
W "Changed ",REF,"=",@REF
S @REF=X
W " to ",@REF,!
Q
ABSPOSC1 ; IHS/FCS/DRS - certification testing ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 QUIT
+3 ;
+4 ; DEVELOPMENT USE ONLY!!! For use when doing certification testing.
+5 ; (Envoy, PCS, etc.)
+6 ;
+7 ; The format has to be in 9002313.92, with NDC BIN number and
+8 ; Envoy plan number filled in.
+9 ; Need to have ^ABSPEI(insurer,100) pointing to the format
+10 ; The insurer comes from $P(^ABSPC(n,0),U,2)
+11 ; Point the insurer to the RESERVED - FOR TESTING dial out.
+12 ;
+13 ; Have to set up an entry in 9002313.31. Fill in values for
+14 ; each of the NCPDP data dictionary fields for the test claim.
+15 ; In general, DON'T fill in 101 BIN Number. It will pick up the
+16 ; Envoy plan number from the 9002313.92 record for you.
+17 ;
+18 ; Once, before doing any of these,
+19 ;
+20 ; DO SETINSUR^ABSPOSC1(low,high pointer to 9002313.31)
+21 ; It prompts for insurer and sets the right insurer into each of
+22 ; those .31 records.
+23 ;
+24 ; ABSP INSURER file - ABSP SETUP INSURER QUICK to attach it to
+25 ; the format you're testing.
+26 ;
+27 ; DO SETDATE^ABSPOSC1(date,low,high pointer to 9002313.31)
+28 ;
+29 ;
+30 ; Then, to test an individual claim:
+31 ;
+32 ; DO TEST^ABSPOSC2(pointer to 9002313.31)
+33 ; But if you're doing a Reversal,
+34 ; instead DO REVERSAL^ABSPOSC2(pointer to 9002313.31)
+35 ; Temporarily uncomment the line in RXI4REV^ABSPOSU
+36 ;
+37 ; DO SEND^ABSPOSC2(pointer to 9002313.31) to transmit
+38 ;
+39 ; DO LOG^ABSPOSC2 to invoke ABSP COMMS LOG
+40 ; RESERVED - FOR TESTING is dial out `5 (saves typing!)
+41 ;
+42 ; DO PRINT^ABSPOSC2(pointer to 9002313.31) to dump raw claim
+43 ; and response packets
+44 ; DO PRINTR^ABSPOSC2(pointer to 9002313.31) to dump response only
+45 ;
+46 ; Use Fileman to print 9002313.02, .03 fields' contents.
+47 ; DO ^%G on ^ABSPC(entry # to look at fields that
+48 ; way, especially the trailing spaces.
+49 ;
+50 ; When there's multiple test claims to send, and the data varies
+51 ; just a little bit, use fileman Transfer Entries, then Enter/Edit
+52 ; to change the few that need to be changed.
+53 ;
+54 QUIT
+55 ; Utilities to operate on lots of claims at once:
SETDATE(DATE,LOW,HIGH) ; Set DATE FILLED,DATE WRITTEN fields
+1 ; to the given date ; DT is a good choice for parameter 1!
+2 NEW CLAIM,FIELD
+3 IF '$GET(DATE)
SET DATE=DT
+4 FOR CLAIM=LOW:1:HIGH
FOR FIELD=401,414
DO SETFIELD(CLAIM,FIELD,DATE)
+5 QUIT
SETINSUR(LOW,HIGH) ;
+1 NEW DIC,X,DTIME,DLAYGO,DINUM,Y,DTOUT,DUOUT
+2 SET DIC="^AUTNINS("
SET DIC(0)="AEMN"
DO ^DIC
IF Y<1
QUIT
SET Y=+Y
+3 FOR CLAIM=LOW:1:HIGH
DO SET0(CLAIM,4,Y)
+4 QUIT
SET0(CLAIM,PIECE,VALUE) ; set given piece of 0 node of 9002313.31 entry
+1 IF '$DATA(^ABSP(9002313.31,CLAIM))
QUIT
+2 SET X=^ABSP(9002313.31,CLAIM,0)
+3 ;=$ZR
NEW REF
SET REF="^ABSP(9002313.31,"_CLAIM_",0)"
+4 ; save old values, just in case
SET ^TMP("ABSP",$JOB,"ABSPOSC1",DT,REF)=X
+5 SET $PIECE(X,U,PIECE)=Y
+6 SET ^ABSP(9002313.31,CLAIM,0)=X
+7 WRITE "Done for `",CLAIM,": ",X,!
+8 QUIT
SETFIELD(CLAIM,FIELD,VALUE) ; general - set NCPDP field # value for given
+1 ; entry in 9002313.31 ; both in claim header and prescription detail
+2 NEW M,N
SET M=0
+3 ; claim header loop
FOR
SET M=$ORDER(^ABSP(9002313.31,CLAIM,1,M))
IF 'M
QUIT
Begin DoDot:1
+4 NEW X
SET X=^ABSP(9002313.31,CLAIM,1,M,0)
+5 ;,REF=$ZR
SET REF="^ABSP(9002313.31,"_CLAIM_",1,"_M_",0)"
+6 DO SETF1
End DoDot:1
+7 ; presc loop
SET N=0
FOR
SET N=$ORDER(^ABSP(9002313.31,CLAIM,2,N))
IF 'N
QUIT
Begin DoDot:1
+8 NEW M
SET M=0
+9 ; field in presc
FOR
SET M=$ORDER(^ABSP(9002313.31,CLAIM,2,N,1,M))
IF 'M
QUIT
Begin DoDot:2
+10 NEW X
SET X=^ABSP(9002313.31,CLAIM,2,N,1,M,0)
+11 ;,REF=$ZR
SET REF="^ABSP(9002313.31,"_CLAIM_",2,"_N_",1,"_M_",0)"
+12 DO SETF1
End DoDot:2
End DoDot:1
+13 QUIT
SETF1 ; given REF, X, FIELD, VALUE
+1 ; safety!!!
IF REF'?1"^ABSP(9002313.31,".E
Begin DoDot:1
+2 DO IMPOSS^ABSPOSUE("P","T","Bad global REF="_REF,,"SETF1",$TEXT(+0))
End DoDot:1
QUIT
+3 ; pointer to 9002313.91
NEW F
SET F=$PIECE(X,U)
+4 NEW Y
SET Y=^ABSPF(9002313.91,F,0)
+5 ; match on NCPDP Field #
IF $PIECE(Y,U)'=FIELD
QUIT
+6 ; save old value of node
SET ^TMP("ABSP",$JOB,"ABSPOSC1",DT,REF)=X
+7 ; replace it with the new value
SET $PIECE(X,U,2)=VALUE
+8 WRITE "Changed ",REF,"=",@REF
+9 SET @REF=X
+10 WRITE " to ",@REF,!
+11 QUIT
