Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HDISDSR1

HDISDSR1.m

Go to the documentation of this file.
  1. HDISDSR1 ;BPFO/DTG - HDI MAILMAN SERVER COLLECT SDO DATA; Apr 07, 2018@12:42
  1. ;;1.0;HEALTH DATA & INFORMATICS;**22**;Feb 22, 2005;Build 26
  1. ;
  1. ;
  1. INIT ; initialize vars and file
  1. ;
  1. ; Uses ICR 5812 to read file 4.3 field 8.3
  1. ;
  1. K @HDISV
  1. S HDITXT=0,HDICRLF=$C(13,10),HDITAB=$C(9),HDIJB=$J,U="^"
  1. S HDISTR=""
  1. S HDISITE=$$SITE^VASITE,HDISTN=$P(HDISITE,"^",2),HDIST=$P(HDISITE,"^",3)
  1. I HDIST="" S HDIST="???"
  1. ;
  1. S HDISUB=$$UP^XLFSTR(XQSUB)
  1. ;get max lines and make character count
  1. N A,B S A=$$GET1^DIQ(4.3,"1,",8.3,"I") S B=$S((+A=0):5469,(A>15000):15000,1:A)
  1. S HDIMAX=((B*250)-((B*250)*.3))\1
  1. ;
  1. Q
  1. ;
  1. MAILSEND(HDISUBJ) ; Send extract back to requestor.
  1. ;
  1. N HDINSTR,HDITASK,HDITO,XMERR,XMZ,A
  1. ;
  1. ;ZEXCEPT: XQSND
  1. ;
  1. ;S 1=1
  1. S HDITO(XQSND)=""
  1. S HDINSTR("ADDR FLAGS")="R"
  1. S HDINSTR("FROM")="HDI_SDO_CODES"
  1. S HDISUBJ=$E(HDISUBJ,1,65)
  1. D SENDMSG^XMXAPI(.5,HDISUBJ,"^TMP($J,""HDIDATA"")",.HDITO,.HDINSTR,.HDITASK)
  1. S A=$G(^DTGHD("A",0)),A=A+1,^DTGHD("A",0)=A,^DTGHD("A",A)=HDITASK
  1. Q
  1. ;
  1. ENCODE(HDISTR) ; Encode a string, keep remainder for next line
  1. ; Call with ORSTR by reference, Remainder returned in LRSTR
  1. ;
  1. S HDIQUIT=0,HDILEN=$L(HDISTR)
  1. F D Q:HDIQUIT
  1. . I $L(HDISTR)<45 S HDIQUIT=1 Q
  1. . S HDIX=$E(HDISTR,1,45),LT=LT+$L(HDIX)
  1. . S HDINODE=HDINODE+1,@HDISV@(HDINODE)=$$UUEN(HDIX)
  1. . S HDISTR=$E(HDISTR,46,HDILEN)
  1. Q
  1. ;
  1. UUEN(STR) ; Uuencode string passed in.
  1. N J,K,LEN,HDII,HDIX,S,TMP,X,Y
  1. S TMP="",LEN=$L(STR)
  1. F HDII=1:3:LEN D
  1. . S HDIX=$E(STR,HDII,HDII+2)
  1. . I $L(HDIX)<3 S HDIX=HDIX_$E(" ",1,3-$L(HDIX))
  1. . S S=$A(HDIX,1)*256+$A(HDIX,2)*256+$A(HDIX,3),Y=""
  1. . F K=0:1:23 S Y=(S\(2**K)#2)_Y
  1. . F K=1:6:24 D
  1. . . S J=$$DEC^XLFUTL($E(Y,K,K+5),2)
  1. . . S TMP=TMP_$C(J+32)
  1. S TMP=$C(LEN+32)_TMP
  1. Q TMP
  1. ;
  1. UUBEGFN(HDFILENM) ; Construct uuencode "begin" coding
  1. ; Call with HDFILENM = name of uuencoded file attachment
  1. ;
  1. ; Returns HDIX = string with "begin..."_file name
  1. ;
  1. N HDIX
  1. S HDIX="begin 644 "_HDFILENM
  1. Q HDIX
  1. ;
  1. ;
  1. SETDATA ; Set data into report structure
  1. S HDINODE=$O(^TMP($J,"HDIDATA",""),-1)
  1. I HDITXT S HDINODE=HDINODE+1,@HDISV@(HDINODE)=HDISTR,HDISTR="" Q
  1. I 'HDITXT D ENCODE(.HDISTR)
  1. Q
  1. ;
  1. CLEAN ; clean up
  1. D CLEAN^HDISDSR
  1. D ^%ZISC
  1. Q
  1. ;
  1. DISER ; display return error type
  1. I RERROR=0 Q
  1. N MSG,A,I,B,J,RR
  1. ; remove multi's of repeating error #'s
  1. F I=1:1 S A=$P(RERROR,",",I) Q:A="" S B(A)=""
  1. ;
  1. S J=$O(@HDISV@(""),-1),J=J+1
  1. S @HDISV@(J)=$$UUBEGFN(HDIFER)
  1. S HDISTR="ERROR ITEMS FROM HDI SDO LOOKUP"_HDICRLF
  1. D SETDATA
  1. S A=0 F S A=$O(B(A)) Q:'A S HDISTR=HDISTR_A_") "_$P($T(DISTXT+A),";",3)_HDICRLF D SETDATA
  1. I $O(RERRARY(0))>0 D ;<
  1. . S HDISTR=HDISTR_HDICRLF_"Error Array Display"_HDICRLF D SETDATA
  1. . S A=0 F S A=$O(RERRARY(A)) Q:'A S HDISTR=HDISTR_RERRARY(A)_HDICRLF D SETDATA
  1. I HDISTR'="" S HDINODE=HDINODE+1,@HDISV@(HDINODE)=$$UUEN(HDISTR)
  1. S @HDISV@(HDINODE+1)=" "
  1. S @HDISV@(HDINODE+2)="end"
  1. Q
  1. ;
  1. DISTXT ; error text
  1. ;;Area Not Sent.
  1. ;;Lookup Value Not Sent.
  1. ;;Return Value Not Sent.
  1. ;;Improper Search Area
  1. ;;Single Item Not Found in ORDERABLE ITEMS File 101.43.
  1. ;;Single Item Not in Area.
  1. ;;Partial Lookup Error.
  1. ;;Orderable Items File Does Not Have Lab Pointer for Item.
  1. ;;Orderable Item Lab Pointer Not Found in Lab File.
  1. ;;
  1. ;;
  1. ;;Type of Lookup not Sent