- 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 Feb 18, 2025@23:55:02 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