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

RGMTHFS.m

Go to the documentation of this file.
  1. RGMTHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01
  1. ;;1.0;CLINCAL INFO RESOURCE NETWORK;**25**;30 Apr 99
  1. ;
  1. ;Reference to XPAR based on supported IA #2263
  1. ;Reference to %ZISH based on supported IA #2320
  1. ;Reference to "VAFC HFS SCRATCH" supported by IA #3549
  1. ;
  1. Q
  1. ;
  1. HFS(LINETAG) ;
  1. D HFSOPEN("RPC") I POP D Q
  1. .S ^TMP("RGMTHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_$$GET^XPAR("SYS","VAFC HFS SCRATCH")
  1. .S ^TMP("RGMTHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEDGES."
  1. U IO
  1. D @LINETAG
  1. D HFSCLOSE("RPC")
  1. Q
  1. ;
  1. HFSOPEN(HANDLE) ;
  1. N RGMTDIR,RGMTFILE
  1. S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
  1. S RGMTFILE="RGMT"_DUZ_".DAT"
  1. D OPEN^%ZISH(HANDLE,RGMTDIR,RGMTFILE,"W") Q:POP
  1. S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
  1. Q
  1. ;
  1. HFSCLOSE(HANDLE) ;
  1. N RGMTDIR,RGMTFILE,RGMTDEL
  1. D CLOSE^%ZISH(HANDLE)
  1. K ^TMP("RGMTHFS",$J)
  1. S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
  1. S RGMTFILE="RGMT"_DUZ_".DAT",RGMTDEL(RGMTFILE)=""
  1. S X=$$FTG^%ZISH(RGMTDIR,RGMTFILE,$NAME(^TMP("RGMTHFS",$J,1)),3)
  1. S X=$$DEL^%ZISH(RGMTDIR,$NA(RGMTDEL))
  1. Q
  1. ; ------------------
  1. HFSGET(RM,GOTO) ;
  1. ;RM=Right margin
  1. S:'$G(RM) RM=80
  1. N ZTQUEUED,RGMTHFS,RGMTSUB,RGMTIO
  1. S RGMTHFS="RGMT_"_$J_".DAT",RGMTSUB="RGMTDATA"
  1. D OPEN(.RM,.RGMTHFS,"W",.RGMTIO)
  1. D @GOTO
  1. D CLOSE(.RGMTRM,.RGMTHFS,.RGMTSUB,.RGMTIO)
  1. Q
  1. ;
  1. OPEN(RGMTRM,RGMTHFS,RGMTMODE,RGMTIO) ; -- open WORKSTATION device
  1. ; RGMTRM: right margin
  1. ; RGMTHFS: host file name
  1. ; RGMTMODE: open file in 'R'ead or 'W'rite mode
  1. S ZTQUEUED="" K IOPAR
  1. S IOP="OR WORKSTATION;"_$G(RGMTRM,80)
  1. S %ZIS("HFSMODE")=RGMTMODE,%ZIS("HFSNAME")=RGMTHFS
  1. D ^%ZIS K IOP,%ZIS
  1. U IO S RGMTIO=IO
  1. Q
  1. ;
  1. CLOSE(RGMTRM,RGMTHFS,RGMTSUB,RGMTIO) ; -- close WORKSTATION device
  1. ; RGMTSUB: unique subscript name for output
  1. I IO=RGMTIO D ^%ZISC
  1. U IO
  1. D USEHFS
  1. U IO
  1. Q
  1. USEHFS ; -- use host file to build global array
  1. N IO,RGMTK,SECTION
  1. S SECTION=0
  1. S RGMTK=$$FTG^%ZISH(,RGMTHFS,$NA(^TMP($J,1)),2) I 'RGMTK Q
  1. N RGMTRR S RGMTRR(RGMTHFS)=""
  1. S RGMTK=$$DEL^%ZISH("",$NA(RGMTRR))
  1. Q
  1. DSPPDAT(RGMT) ;
  1. ; Output
  1. ; RGMT - array passed back with the display formatted PDAT call
  1. N CNT,X,TXT
  1. S CNT=0,X=0 F S X=$O(^TMP("RGMTHFS",$J,X)) Q:'X S TXT=^TMP("RGMTHFS",$J,X) D
  1. . I $E(TXT,1,20)="Treating Facilities:" S RGMT(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,12)="Subscribers:" S RGMT(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,12)="ICN History:" S RGMT(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,13)="CMOR History:" S RGMT(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,28)="CMOR Change Request History:" S RGMT(CNT)="" S CNT=CNT+1
  1. . I TXT'="" I $E(TXT,1,12)'="Enter RETURN" S RGMT(CNT)=^TMP("RGMTHFS",$J,X),CNT=CNT+1
  1. Q
  1. ETOT ;
  1. ;remove specific lines from ETOT global
  1. M ^TMP("RGMTHFS1",$J)=^TMP("RGMTHFS",$J) K ^TMP("RGMTHFS",$J)
  1. S CNT=1,X=0 F S X=$O(^TMP("RGMTHFS1",$J,X)) Q:'X S TXT=^TMP("RGMTHFS1",$J,X) D
  1. . I $E(TXT,1,10)="...purging" Q
  1. . I $E(TXT,1,11)="and deleted" Q
  1. . I $E(TXT,1,12)="Data string:" Q
  1. . I $E(TXT,1,10)="Site;Sta#;" Q
  1. .S ^TMP("RGMTHFS",$J,CNT)=^TMP("RGMTHFS1",$J,X)
  1. Q