OCXOCMPZ.m

OCXOCMPZ ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Convert Link Data) ;8/04/98  16:10

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997

 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 ;

EN ;

 ;

 N D0,LINK

 S D0=0 F  S D0=$O(^OCXS(863.3,D0)) Q:'D0  D

 .K LINK M LINK=^OCXS(863.3,D0)

 .S OCXPVN=$$GETPVAL("OCXO VARIABLE NAME")

 .S OCXPVP=$$GETPVAL("OCXO VT-BAR PIECE NUMBER")

 .S OCXPSI=$$GETPVAL("OCXO HL7 SEGMENT ID")

 .;

 .I $L(OCXPVN),'$L(OCXPVP),'$L(OCXPSI) D  Q

 ..W !!,$P(LINK(0),U,1)

 ..W !,"         OCXO VARIABLE NAME: ",OCXPVN

 .;

 .I $L(OCXPVN),$L(OCXPVP),$L(OCXPSI)

 .E  Q

 .W !!

 .W !,$P(LINK(0),U,1)

 .W !,"         OCXO VARIABLE NAME: ",OCXPVN

 .W !,"   OCXO VT-BAR PIECE NUMBER: ",OCXPVP

 .W !,"        OCXO HL7 SEGMENT ID: ",OCXPSI

 .S OCXPVN="OCXODATA("""_OCXPSI_""","_OCXPVP_")",OCXPVP="",OCXPSI=""

 .W !

 .W !,"         OCXO VARIABLE NAME: ",OCXPVN

 .W !,"   OCXO VT-BAR PIECE NUMBER: ",OCXPVP

 .W !,"        OCXO HL7 SEGMENT ID: ",OCXPSI

 .D PUTPVAL(D0,"OCXO VARIABLE NAME",OCXPVN)

 .D PUTPVAL(D0,"OCXO VT-BAR PIECE NUMBER",OCXPVP)

 .D PUTPVAL(D0,"OCXO HL7 SEGMENT ID",OCXPSI)

 ;

 Q

 ;

PUTPVAL(LD0,PAR,VAL) ;

 ;

 N D0,D1

 S D0=$O(^OCXS(863.8,"B",PAR,0)) Q:'D0

 S D1=$O(LINK("PAR","B",D0,0)) Q:'D1

 S ^OCXS(863.3,LD0,"PAR",D1,"VAL")=VAL

 Q

 ;

GETPVAL(PNAME) ;

 ;

 N D0,D1

 S D0=$O(^OCXS(863.8,"B",PNAME,0)) Q:'D0 ""

 S D1=$O(LINK("PAR","B",D0,0)) Q:'D1 ""

 Q $G(LINK("PAR",D1,"VAL"))

 ;

OCXOCMPZ  ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Convert Link Data) ;8/04/98  16:10

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997

 +2       ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998

 +3       ;

EN        ;

 +1       ;

 +2        NEW D0,LINK

 +3        SET D0=0

           FOR 

               SET D0=$ORDER(^OCXS(863.3,D0))

               IF 'D0

                   QUIT 

               Begin DoDot:1

 +4                KILL LINK

                   MERGE LINK=^OCXS(863.3,D0)

 +5                SET OCXPVN=$$GETPVAL("OCXO VARIABLE NAME")

 +6                SET OCXPVP=$$GETPVAL("OCXO VT-BAR PIECE NUMBER")

 +7                SET OCXPSI=$$GETPVAL("OCXO HL7 SEGMENT ID")

 +8       ;

 +9                IF $LENGTH(OCXPVN)

                       IF '$LENGTH(OCXPVP)

                           IF '$LENGTH(OCXPSI)

                               Begin DoDot:2

 +10                               WRITE !!,$PIECE(LINK(0),U,1)

 +11                               WRITE !,"         OCXO VARIABLE NAME: ",OCXPVN

                               End DoDot:2

                               QUIT 

 +12      ;

 +13               IF $LENGTH(OCXPVN)

                       IF $LENGTH(OCXPVP)

                           IF $LENGTH(OCXPSI)

 +14              IF '$TEST

                       QUIT 

 +15               WRITE !!

 +16               WRITE !,$PIECE(LINK(0),U,1)

 +17               WRITE !,"         OCXO VARIABLE NAME: ",OCXPVN

 +18               WRITE !,"   OCXO VT-BAR PIECE NUMBER: ",OCXPVP

 +19               WRITE !,"        OCXO HL7 SEGMENT ID: ",OCXPSI

 +20               SET OCXPVN="OCXODATA("""_OCXPSI_""","_OCXPVP_")"

                   SET OCXPVP=""

                   SET OCXPSI=""

 +21               WRITE !

 +22               WRITE !,"         OCXO VARIABLE NAME: ",OCXPVN

 +23               WRITE !,"   OCXO VT-BAR PIECE NUMBER: ",OCXPVP

 +24               WRITE !,"        OCXO HL7 SEGMENT ID: ",OCXPSI

 +25               DO PUTPVAL(D0,"OCXO VARIABLE NAME",OCXPVN)

 +26               DO PUTPVAL(D0,"OCXO VT-BAR PIECE NUMBER",OCXPVP)

 +27               DO PUTPVAL(D0,"OCXO HL7 SEGMENT ID",OCXPSI)

               End DoDot:1

 +28      ;

 +29       QUIT 

 +30      ;

PUTPVAL(LD0,PAR,VAL) ;

 +1       ;

 +2        NEW D0,D1

 +3        SET D0=$ORDER(^OCXS(863.8,"B",PAR,0))

           IF 'D0

               QUIT 

 +4        SET D1=$ORDER(LINK("PAR","B",D0,0))

           IF 'D1

               QUIT 

 +5        SET ^OCXS(863.3,LD0,"PAR",D1,"VAL")=VAL

 +6        QUIT 

 +7       ;

GETPVAL(PNAME) ;

 +1       ;

 +2        NEW D0,D1

 +3        SET D0=$ORDER(^OCXS(863.8,"B",PNAME,0))

           IF 'D0

               QUIT ""

 +4        SET D1=$ORDER(LINK("PAR","B",D0,0))

           IF 'D1

               QUIT ""

 +5        QUIT $GET(LINK("PAR",D1,"VAL"))

 +6       ;