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"))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMPZ 1475 printed Nov 22, 2024@17:35:06 Page 2
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 ;
