ABSPECR0 ; IHS/FCS/DRS - JWS 02:16 PM 28 Sep 1995 ; [ 09/12/2002 9:59 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
; Development utility:
;NCPDP FIELD Definitions Print-Out
;----------------------------------------------------------------------
EN ;
N FIELD,GCODE,GETN,NEXTIEN,NEXTCODE,RDATA
D ^%ZIS
U IO
W "NCPDP FIELD Definitions:",!
W $TR($J("",IOM)," ","-"),!
S NEXTIEN=0,NEXTCODE=""
F D Q:NEXTCODE=""
.S NEXTCODE=$O(^ABSPF(9002313.91,"B",NEXTCODE)) Q:NEXTCODE=""
.S NEXTIEN=$O(^ABSPF(9002313.91,"B",NEXTCODE,0))
.Q:'+NEXTIEN
.S RDATA=$G(^ABSPF(9002313.91,NEXTIEN,0))
.Q:RDATA=""
.S FIELD=$P(RDATA,U,1)
.W !,$J(FIELD,3)
.I $P(RDATA,U,2)]"" W "-",$P(RDATA,U,2)
.W ?15,$P(RDATA,U,3)
.W " Length: ",$P(RDATA,U,5)
.W !
.;
.; "Get" code
.;
.W ?6,"Get:"
.S GETN=0
.F D Q:'+GETN
..S GETN=$O(^ABSPF(9002313.91,NEXTIEN,10,GETN))
..Q:'+GETN
..S GCODE=$G(^ABSPF(9002313.91,NEXTIEN,10,GETN,0))
..D PRINT
.;
.; "Format" code
.;
.W ?3,"Format:"
.S GETN=0
.F D Q:'+GETN
..S GETN=$O(^ABSPF(9002313.91,NEXTIEN,20,GETN))
..Q:'+GETN
..S GCODE=$G(^ABSPF(9002313.91,NEXTIEN,20,GETN,0))
..D PRINT
.;
.; "Set" code
.;
.W ?6,"Set:"
.S GETN=0
.F D Q:'+GETN
..S GETN=$O(^ABSPF(9002313.91,NEXTIEN,30,GETN))
..Q:'+GETN
..S GCODE=$G(^ABSPF(9002313.91,NEXTIEN,30,GETN,0))
..;W ?10,"S",GETN,": ",GCODE,!
..D PRINT
W !!,"Index",!!
N X S X=""
F S X=$O(^ABSPF(9002313.91,"C",X)) Q:X="" D
. N Y S Y=$O(^ABSPF(9002313.91,"C",X,0))
. S Y=$P(^ABSPF(9002313.91,Y,0),U)
. W X," ",Y,!
D ^%ZISC
;U $P
Q
PRINT ;
I '$G(IOM)<40 N IOM S IOM=80
N C S C=IOM-11-2
W ?11,$E(GCODE,1,C),!
I $L(GCODE)>C N I F I=1:1:$L(GCODE)\C D
. W ?7,"..."
. W ?11,$E(GCODE,C*I+1,C*I+C)
. W !
Q
ABSPECR0 ; IHS/FCS/DRS - JWS 02:16 PM 28 Sep 1995 ; [ 09/12/2002 9:59 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ; Development utility:
+5 ;NCPDP FIELD Definitions Print-Out
+6 ;----------------------------------------------------------------------
EN ;
+1 NEW FIELD,GCODE,GETN,NEXTIEN,NEXTCODE,RDATA
+2 DO ^%ZIS
+3 USE IO
+4 WRITE "NCPDP FIELD Definitions:",!
+5 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","-"),!
+6 SET NEXTIEN=0
SET NEXTCODE=""
+7 FOR
Begin DoDot:1
+8 SET NEXTCODE=$ORDER(^ABSPF(9002313.91,"B",NEXTCODE))
IF NEXTCODE=""
QUIT
+9 SET NEXTIEN=$ORDER(^ABSPF(9002313.91,"B",NEXTCODE,0))
+10 IF '+NEXTIEN
QUIT
+11 SET RDATA=$GET(^ABSPF(9002313.91,NEXTIEN,0))
+12 IF RDATA=""
QUIT
+13 SET FIELD=$PIECE(RDATA,U,1)
+14 WRITE !,$JUSTIFY(FIELD,3)
+15 IF $PIECE(RDATA,U,2)]""
WRITE "-",$PIECE(RDATA,U,2)
+16 WRITE ?15,$PIECE(RDATA,U,3)
+17 WRITE " Length: ",$PIECE(RDATA,U,5)
+18 WRITE !
+19 ;
+20 ; "Get" code
+21 ;
+22 WRITE ?6,"Get:"
+23 SET GETN=0
+24 FOR
Begin DoDot:2
+25 SET GETN=$ORDER(^ABSPF(9002313.91,NEXTIEN,10,GETN))
+26 IF '+GETN
QUIT
+27 SET GCODE=$GET(^ABSPF(9002313.91,NEXTIEN,10,GETN,0))
+28 DO PRINT
End DoDot:2
IF '+GETN
QUIT
+29 ;
+30 ; "Format" code
+31 ;
+32 WRITE ?3,"Format:"
+33 SET GETN=0
+34 FOR
Begin DoDot:2
+35 SET GETN=$ORDER(^ABSPF(9002313.91,NEXTIEN,20,GETN))
+36 IF '+GETN
QUIT
+37 SET GCODE=$GET(^ABSPF(9002313.91,NEXTIEN,20,GETN,0))
+38 DO PRINT
End DoDot:2
IF '+GETN
QUIT
+39 ;
+40 ; "Set" code
+41 ;
+42 WRITE ?6,"Set:"
+43 SET GETN=0
+44 FOR
Begin DoDot:2
+45 SET GETN=$ORDER(^ABSPF(9002313.91,NEXTIEN,30,GETN))
+46 IF '+GETN
QUIT
+47 SET GCODE=$GET(^ABSPF(9002313.91,NEXTIEN,30,GETN,0))
+48 ;W ?10,"S",GETN,": ",GCODE,!
+49 DO PRINT
End DoDot:2
IF '+GETN
QUIT
End DoDot:1
IF NEXTCODE=""
QUIT
+50 WRITE !!,"Index",!!
+51 NEW X
SET X=""
+52 FOR
SET X=$ORDER(^ABSPF(9002313.91,"C",X))
IF X=""
QUIT
Begin DoDot:1
+53 NEW Y
SET Y=$ORDER(^ABSPF(9002313.91,"C",X,0))
+54 SET Y=$PIECE(^ABSPF(9002313.91,Y,0),U)
+55 WRITE X," ",Y,!
End DoDot:1
+56 DO ^%ZISC
+57 ;U $P
+58 QUIT
PRINT ;
+1 IF '$GET(IOM)<40
NEW IOM
SET IOM=80
+2 NEW C
SET C=IOM-11-2
+3 WRITE ?11,$EXTRACT(GCODE,1,C),!
+4 IF $LENGTH(GCODE)>C
NEW I
FOR I=1:1:$LENGTH(GCODE)\C
Begin DoDot:1
+5 WRITE ?7,"..."
+6 WRITE ?11,$EXTRACT(GCODE,C*I+1,C*I+C)
+7 WRITE !
End DoDot:1
+8 QUIT
