ONCSNACR ;HINES OIFO/SG - NACCR TOOLS ; 3/9/07 10:40am
;;2.2;ONCOLOGY;**1,13**;Jul 31, 2013;Build 7
;
; ONC8DST ------------- DESCRIPTOR OF THE DESTINATION BUFFER
; (a parameter of BEGIN, END, FLUSH, and
; WRITE). See also the ^ONCSAPIR.
;
; ONC8DST( Closed root of the destination buffer
; "BUF") Output buffer
; "LBA") Available space in the output buffer
; "PTR") Pointer in the destination buffer
; "PTRC") Continuation pointer (optional)
;
Q
;
;***** STARTS THE NAACCR RECORD OUTPUT
;
; [.ONC8DST] Reference to a descriptor of the destination buffer
;
BEGIN(ONC8DST) ;
Q:$G(ONC8DST)=""
K ONC8DST("BUF"),ONC8DST("LBA")
S:'$D(ONC8DST("PTR")) ONC8DST("PTR")=+$O(@ONC8DST@(""),-1)
;--- Open tag for the NAACCR record
D PUT^ONCSAPIR(.ONC8DST,"NAACCR-RECORD",,1)
D FLUSH(.ONC8DST)
Q
;
;***** RETURNS CRC32 VALUE FOR THE NAACCR RECORD
;
; [.ONC8DST] Reference to a descriptor of the destination buffer
;
; Return values:
; 0 NAACCR record data has not been found
; ... CRC32 value
;
CRC32(ONC8DST) ;
N BUF,CRC,FLT,FLTL,PI
S FLTL=$L(ONC8DST)-1,FLT=$E(ONC8DST,1,FLTL)
;--- Search for beginning of the record data
S PI=ONC8DST
F S PI=$Q(@PI) Q:$E(PI,1,FLTL)'=FLT Q:$E(@PI,1,14)="<NAACCR-RECORD"
Q:$E(PI,1,FLTL)'=FLT 0
;--- Calculate the checksum
S CRC=4294967295
F S PI=$Q(@PI) Q:$E(PI,1,FLTL)'=FLT S BUF=@PI Q:BUF="</NAACCR-RECORD>" D
. S CRC=$$CRC32^XLFCRC(BUF,CRC)
;--- Success
Q CRC
;
;***** FINISHES THE NAACCR RECORD OUTPUT
;
; [.ONC8DST] Reference to a descriptor of the destination buffer
;
END(ONC8DST) ;
I $G(ONC8DST)="" W ! Q
;--- Close tag for the NAACCR record
D FLUSH(.ONC8DST),APPEND^ONCSAPIR(.ONC8DST,"</NAACCR-RECORD>",1)
K ONC8DST("BUF"),ONC8DST("LBA")
Q
;
;***** FLUSHES THE OUTPUT BUFFER
;
; [.ONC8DST] Reference to a descriptor of the destination buffer
;
FLUSH(ONC8DST) ;
Q:$G(ONC8DST)=""
D:$G(ONC8DST("BUF"))'="" APPEND^ONCSAPIR(.ONC8DST,ONC8DST("BUF"),1)
S ONC8DST("BUF")="",ONC8DST("LBA")=250
Q
;
;***** OUTPUTS THE PIECE OF THE NAACCR RECORD
;
; [.ONC8DST] Reference to a descriptor of the destination buffer
;
; VAL A piece of the NAACCR record
;
WRITE(ONC8DST,VAL) ;
I $G(ONC8DST)="" W VAL Q
N ENCTXT,LT
; S ENCTXT=$$SYMENC^MXMLUTL(VAL),LT=$L(ENCTXT) ;remove call to fix CHKERR length problem
S ENCTXT=VAL,LT=$L(ENCTXT)
F Q:LT'>0 D
. I LT>ONC8DST("LBA") D
. . S ONC8DST("BUF")=ONC8DST("BUF")_$E(ENCTXT,1,ONC8DST("LBA"))
. . S $E(ENCTXT,1,ONC8DST("LBA"))=""
. . S LT=LT-ONC8DST("LBA"),ONC8DST("LBA")=0
. E D
. . S ONC8DST("BUF")=ONC8DST("BUF")_ENCTXT
. . S ONC8DST("LBA")=ONC8DST("LBA")-LT,LT=0
. D:ONC8DST("LBA")'>0 FLUSH(.ONC8DST)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSNACR 2908 printed Apr 09, 2024@21:25:13 Page 2
ONCSNACR ;HINES OIFO/SG - NACCR TOOLS ; 3/9/07 10:40am
+1 ;;2.2;ONCOLOGY;**1,13**;Jul 31, 2013;Build 7
+2 ;
+3 ; ONC8DST ------------- DESCRIPTOR OF THE DESTINATION BUFFER
+4 ; (a parameter of BEGIN, END, FLUSH, and
+5 ; WRITE). See also the ^ONCSAPIR.
+6 ;
+7 ; ONC8DST( Closed root of the destination buffer
+8 ; "BUF") Output buffer
+9 ; "LBA") Available space in the output buffer
+10 ; "PTR") Pointer in the destination buffer
+11 ; "PTRC") Continuation pointer (optional)
+12 ;
+13 QUIT
+14 ;
+15 ;***** STARTS THE NAACCR RECORD OUTPUT
+16 ;
+17 ; [.ONC8DST] Reference to a descriptor of the destination buffer
+18 ;
BEGIN(ONC8DST) ;
+1 if $GET(ONC8DST)=""
QUIT
+2 KILL ONC8DST("BUF"),ONC8DST("LBA")
+3 if '$DATA(ONC8DST("PTR"))
SET ONC8DST("PTR")=+$ORDER(@ONC8DST@(""),-1)
+4 ;--- Open tag for the NAACCR record
+5 DO PUT^ONCSAPIR(.ONC8DST,"NAACCR-RECORD",,1)
+6 DO FLUSH(.ONC8DST)
+7 QUIT
+8 ;
+9 ;***** RETURNS CRC32 VALUE FOR THE NAACCR RECORD
+10 ;
+11 ; [.ONC8DST] Reference to a descriptor of the destination buffer
+12 ;
+13 ; Return values:
+14 ; 0 NAACCR record data has not been found
+15 ; ... CRC32 value
+16 ;
CRC32(ONC8DST) ;
+1 NEW BUF,CRC,FLT,FLTL,PI
+2 SET FLTL=$LENGTH(ONC8DST)-1
SET FLT=$EXTRACT(ONC8DST,1,FLTL)
+3 ;--- Search for beginning of the record data
+4 SET PI=ONC8DST
+5 FOR
SET PI=$QUERY(@PI)
if $EXTRACT(PI,1,FLTL)'=FLT
QUIT
if $EXTRACT(@PI,1,14)="<NAACCR-RECORD"
QUIT
+6 if $EXTRACT(PI,1,FLTL)'=FLT
QUIT 0
+7 ;--- Calculate the checksum
+8 SET CRC=4294967295
+9 FOR
SET PI=$QUERY(@PI)
if $EXTRACT(PI,1,FLTL)'=FLT
QUIT
SET BUF=@PI
if BUF="</NAACCR-RECORD>"
QUIT
Begin DoDot:1
+10 SET CRC=$$CRC32^XLFCRC(BUF,CRC)
End DoDot:1
+11 ;--- Success
+12 QUIT CRC
+13 ;
+14 ;***** FINISHES THE NAACCR RECORD OUTPUT
+15 ;
+16 ; [.ONC8DST] Reference to a descriptor of the destination buffer
+17 ;
END(ONC8DST) ;
+1 IF $GET(ONC8DST)=""
WRITE !
QUIT
+2 ;--- Close tag for the NAACCR record
+3 DO FLUSH(.ONC8DST)
DO APPEND^ONCSAPIR(.ONC8DST,"</NAACCR-RECORD>",1)
+4 KILL ONC8DST("BUF"),ONC8DST("LBA")
+5 QUIT
+6 ;
+7 ;***** FLUSHES THE OUTPUT BUFFER
+8 ;
+9 ; [.ONC8DST] Reference to a descriptor of the destination buffer
+10 ;
FLUSH(ONC8DST) ;
+1 if $GET(ONC8DST)=""
QUIT
+2 if $GET(ONC8DST("BUF"))'=""
DO APPEND^ONCSAPIR(.ONC8DST,ONC8DST("BUF"),1)
+3 SET ONC8DST("BUF")=""
SET ONC8DST("LBA")=250
+4 QUIT
+5 ;
+6 ;***** OUTPUTS THE PIECE OF THE NAACCR RECORD
+7 ;
+8 ; [.ONC8DST] Reference to a descriptor of the destination buffer
+9 ;
+10 ; VAL A piece of the NAACCR record
+11 ;
WRITE(ONC8DST,VAL) ;
+1 IF $GET(ONC8DST)=""
WRITE VAL
QUIT
+2 NEW ENCTXT,LT
+3 ; S ENCTXT=$$SYMENC^MXMLUTL(VAL),LT=$L(ENCTXT) ;remove call to fix CHKERR length problem
+4 SET ENCTXT=VAL
SET LT=$LENGTH(ENCTXT)
+5 FOR
if LT'>0
QUIT
Begin DoDot:1
+6 IF LT>ONC8DST("LBA")
Begin DoDot:2
+7 SET ONC8DST("BUF")=ONC8DST("BUF")_$EXTRACT(ENCTXT,1,ONC8DST("LBA"))
+8 SET $EXTRACT(ENCTXT,1,ONC8DST("LBA"))=""
+9 SET LT=LT-ONC8DST("LBA")
SET ONC8DST("LBA")=0
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 SET ONC8DST("BUF")=ONC8DST("BUF")_ENCTXT
+12 SET ONC8DST("LBA")=ONC8DST("LBA")-LT
SET LT=0
End DoDot:2
+13 if ONC8DST("LBA")'>0
DO FLUSH(.ONC8DST)
End DoDot:1
+14 QUIT
