- 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