ABSPOSAY ; IHS/FCS/DRS - Packet print utils ; [ 09/12/2002 10:07 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;---------------------------------------------------------------------
Q
;
; D DUMPLAST ; look at most recent response and associated claim.
;
; D DUMPN(pointer to 9002313.02) prints claim and response both
;
; Development and low-level support utilities
; Most useful callable entry points are:
; PRINT02(pointer to 9002313.02)
; PRINT03(pointer to 9002313.03)
; DIAGPRT(string) to print diagram in pretty formatted form
;
;
DUMPLAST ; Print the most recently-received claim-response pair
N IEN03 S IEN03=$P(^ABSPR(0),U,3)
N IEN02 S IEN02=$P(^ABSPR(IEN03,0),U)
D PRINT02(IEN02),PRINT03(IEN03)
Q
;
;
DUMP(REQ) ; given REQ = ien or ID of request packet, do the whole thing
I REQ'?1N.N D Q:REQ=""
. S REQ=$O(^ABSPC("B",REQ,0))
D PRINT02(REQ)
N IEN03 S IEN03=$O(^ABSPR("B",REQ,""),-1) ; most recent response!
I IEN03 D PRINT03(IEN03)
Q
;
; Useful entry points now that we retain raw packet in 9002313.02,.03
; (earlier versions just saved the one single most recent packet)
;
PRINT02(N) ;EP - dump of a claim packet
D PRINT0X(9002313.02,N) Q
PRINT03(N) ;EP - dump of a response packet
D PRINT0X(9002313.03,N) Q
PRINT0X(FILE,N) ; dump of a claim or response, given file number and IEN
I FILE=9002313.02 D
. W "Claim `",N," ",$P(^ABSPC(N,0),U)
. N X S X=$P(^ABSPC(N,0),U,5)
. I X W " transmitted ",X
. S X=$P(^ABSPC(N,0),U,6)
. I X W " created ",X
E W "Response `",N," received ",$P(^ABSPR(N,0),U,2)
N PKT S PKT=$$GETPKT(FILE,N)
D DIAGPRT(PKT)
Q
GETPKT(FILE,N) ; reassemble
N X,ROOT
S X="",ROOT="^ABSP"_$S(FILE=9002313.02:"C",FILE=9002313.03:"R")
F I=1:1:$P(@ROOT@(N,"M",0),U,3) D
. S X=X_@ROOT@(N,"M",I,0)
Q X
;
; DIAGPRT(string) to print the given string in a pretty formatted way
;
DIAGPRT(A) ;
N I,J,K,X
I $E(A)=$C(2) S A=$E(A,2,$L(A))
I $E(A,1,3)="HN."!($E(A,1,3)="HN*") S A=$E(A,4,$L(A))
F I=1:15:$L(A) D
.W !,$J(I,4),"/ "
.F J=0:1:14 S K=I+J Q:K>$L(A) S X=$E(A,K) D
..I X=" " W " ","sp"," "
..E I X?1ANP W " ","'",X,"'"
..E W $J($A(X),4)
W ! Q
ABSPOSAY ; IHS/FCS/DRS - Packet print utils ; [ 09/12/2002 10:07 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;---------------------------------------------------------------------
+3 QUIT
+4 ;
+5 ; D DUMPLAST ; look at most recent response and associated claim.
+6 ;
+7 ; D DUMPN(pointer to 9002313.02) prints claim and response both
+8 ;
+9 ; Development and low-level support utilities
+10 ; Most useful callable entry points are:
+11 ; PRINT02(pointer to 9002313.02)
+12 ; PRINT03(pointer to 9002313.03)
+13 ; DIAGPRT(string) to print diagram in pretty formatted form
+14 ;
+15 ;
DUMPLAST ; Print the most recently-received claim-response pair
+1 NEW IEN03
SET IEN03=$PIECE(^ABSPR(0),U,3)
+2 NEW IEN02
SET IEN02=$PIECE(^ABSPR(IEN03,0),U)
+3 DO PRINT02(IEN02)
DO PRINT03(IEN03)
+4 QUIT
+5 ;
+6 ;
DUMP(REQ) ; given REQ = ien or ID of request packet, do the whole thing
+1 IF REQ'?1N.N
Begin DoDot:1
+2 SET REQ=$ORDER(^ABSPC("B",REQ,0))
End DoDot:1
IF REQ=""
QUIT
+3 DO PRINT02(REQ)
+4 ; most recent response!
NEW IEN03
SET IEN03=$ORDER(^ABSPR("B",REQ,""),-1)
+5 IF IEN03
DO PRINT03(IEN03)
+6 QUIT
+7 ;
+8 ; Useful entry points now that we retain raw packet in 9002313.02,.03
+9 ; (earlier versions just saved the one single most recent packet)
+10 ;
PRINT02(N) ;EP - dump of a claim packet
+1 DO PRINT0X(9002313.02,N)
QUIT
PRINT03(N) ;EP - dump of a response packet
+1 DO PRINT0X(9002313.03,N)
QUIT
PRINT0X(FILE,N) ; dump of a claim or response, given file number and IEN
+1 IF FILE=9002313.02
Begin DoDot:1
+2 WRITE "Claim `",N," ",$PIECE(^ABSPC(N,0),U)
+3 NEW X
SET X=$PIECE(^ABSPC(N,0),U,5)
+4 IF X
WRITE " transmitted ",X
+5 SET X=$PIECE(^ABSPC(N,0),U,6)
+6 IF X
WRITE " created ",X
End DoDot:1
+7 IF '$TEST
WRITE "Response `",N," received ",$PIECE(^ABSPR(N,0),U,2)
+8 NEW PKT
SET PKT=$$GETPKT(FILE,N)
+9 DO DIAGPRT(PKT)
+10 QUIT
GETPKT(FILE,N) ; reassemble
+1 NEW X,ROOT
+2 SET X=""
SET ROOT="^ABSP"_$SELECT(FILE=9002313.02:"C",FILE=9002313.03:"R")
+3 FOR I=1:1:$PIECE(@ROOT@(N,"M",0),U,3)
Begin DoDot:1
+4 SET X=X_@ROOT@(N,"M",I,0)
End DoDot:1
+5 QUIT X
+6 ;
+7 ; DIAGPRT(string) to print the given string in a pretty formatted way
+8 ;
DIAGPRT(A) ;
+1 NEW I,J,K,X
+2 IF $EXTRACT(A)=$CHAR(2)
SET A=$EXTRACT(A,2,$LENGTH(A))
+3 IF $EXTRACT(A,1,3)="HN."!($EXTRACT(A,1,3)="HN*")
SET A=$EXTRACT(A,4,$LENGTH(A))
+4 FOR I=1:15:$LENGTH(A)
Begin DoDot:1
+5 WRITE !,$JUSTIFY(I,4),"/ "
+6 FOR J=0:1:14
SET K=I+J
IF K>$LENGTH(A)
QUIT
SET X=$EXTRACT(A,K)
Begin DoDot:2
+7 IF X=" "
WRITE " ","sp"," "
+8 IF '$TEST
IF X?1ANP
WRITE " ","'",X,"'"
+9 IF '$TEST
WRITE $JUSTIFY($ASCII(X),4)
End DoDot:2
End DoDot:1
+10 WRITE !
QUIT
