ABSPECR0.m

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