source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTHFS.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1RGMTHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01
2 ;;1.0;CLINCAL INFO RESOURCE NETWORK;**25**;30 Apr 99
3 ;
4 ;Reference to XPAR based on supported IA #2263
5 ;Reference to %ZISH based on supported IA #2320
6 ;Reference to "VAFC HFS SCRATCH" supported by IA #3549
7 ;
8 Q
9 ;
10HFS(LINETAG) ;
11 D HFSOPEN("RPC") I POP D Q
12 .S ^TMP("RGMTHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_$$GET^XPAR("SYS","VAFC HFS SCRATCH")
13 .S ^TMP("RGMTHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEDGES."
14 U IO
15 D @LINETAG
16 D HFSCLOSE("RPC")
17 Q
18 ;
19HFSOPEN(HANDLE) ;
20 N RGMTDIR,RGMTFILE
21 S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
22 S RGMTFILE="RGMT"_DUZ_".DAT"
23 D OPEN^%ZISH(HANDLE,RGMTDIR,RGMTFILE,"W") Q:POP
24 S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
25 Q
26 ;
27HFSCLOSE(HANDLE) ;
28 N RGMTDIR,RGMTFILE,RGMTDEL
29 D CLOSE^%ZISH(HANDLE)
30 K ^TMP("RGMTHFS",$J)
31 S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
32 S RGMTFILE="RGMT"_DUZ_".DAT",RGMTDEL(RGMTFILE)=""
33 S X=$$FTG^%ZISH(RGMTDIR,RGMTFILE,$NAME(^TMP("RGMTHFS",$J,1)),3)
34 S X=$$DEL^%ZISH(RGMTDIR,$NA(RGMTDEL))
35 Q
36 ; ------------------
37HFSGET(RM,GOTO) ;
38 ;RM=Right margin
39 S:'$G(RM) RM=80
40 N ZTQUEUED,RGMTHFS,RGMTSUB,RGMTIO
41 S RGMTHFS="RGMT_"_$J_".DAT",RGMTSUB="RGMTDATA"
42 D OPEN(.RM,.RGMTHFS,"W",.RGMTIO)
43 D @GOTO
44 D CLOSE(.RGMTRM,.RGMTHFS,.RGMTSUB,.RGMTIO)
45 Q
46 ;
47OPEN(RGMTRM,RGMTHFS,RGMTMODE,RGMTIO) ; -- open WORKSTATION device
48 ; RGMTRM: right margin
49 ; RGMTHFS: host file name
50 ; RGMTMODE: open file in 'R'ead or 'W'rite mode
51 S ZTQUEUED="" K IOPAR
52 S IOP="OR WORKSTATION;"_$G(RGMTRM,80)
53 S %ZIS("HFSMODE")=RGMTMODE,%ZIS("HFSNAME")=RGMTHFS
54 D ^%ZIS K IOP,%ZIS
55 U IO S RGMTIO=IO
56 Q
57 ;
58CLOSE(RGMTRM,RGMTHFS,RGMTSUB,RGMTIO) ; -- close WORKSTATION device
59 ; RGMTSUB: unique subscript name for output
60 I IO=RGMTIO D ^%ZISC
61 U IO
62 D USEHFS
63 U IO
64 Q
65USEHFS ; -- use host file to build global array
66 N IO,RGMTK,SECTION
67 S SECTION=0
68 S RGMTK=$$FTG^%ZISH(,RGMTHFS,$NA(^TMP($J,1)),2) I 'RGMTK Q
69 N RGMTRR S RGMTRR(RGMTHFS)=""
70 S RGMTK=$$DEL^%ZISH("",$NA(RGMTRR))
71 Q
72DSPPDAT(RGMT) ;
73 ; Output
74 ; RGMT - array passed back with the display formatted PDAT call
75 N CNT,X,TXT
76 S CNT=0,X=0 F S X=$O(^TMP("RGMTHFS",$J,X)) Q:'X S TXT=^TMP("RGMTHFS",$J,X) D
77 . I $E(TXT,1,20)="Treating Facilities:" S RGMT(CNT)="" S CNT=CNT+1
78 . I $E(TXT,1,12)="Subscribers:" S RGMT(CNT)="" S CNT=CNT+1
79 . I $E(TXT,1,12)="ICN History:" S RGMT(CNT)="" S CNT=CNT+1
80 . I $E(TXT,1,13)="CMOR History:" S RGMT(CNT)="" S CNT=CNT+1
81 . I $E(TXT,1,28)="CMOR Change Request History:" S RGMT(CNT)="" S CNT=CNT+1
82 . I TXT'="" I $E(TXT,1,12)'="Enter RETURN" S RGMT(CNT)=^TMP("RGMTHFS",$J,X),CNT=CNT+1
83 Q
84ETOT ;
85 ;remove specific lines from ETOT global
86 M ^TMP("RGMTHFS1",$J)=^TMP("RGMTHFS",$J) K ^TMP("RGMTHFS",$J)
87 S CNT=1,X=0 F S X=$O(^TMP("RGMTHFS1",$J,X)) Q:'X S TXT=^TMP("RGMTHFS1",$J,X) D
88 . I $E(TXT,1,10)="...purging" Q
89 . I $E(TXT,1,11)="and deleted" Q
90 . I $E(TXT,1,12)="Data string:" Q
91 . I $E(TXT,1,10)="Site;Sta#;" Q
92 .S ^TMP("RGMTHFS",$J,CNT)=^TMP("RGMTHFS1",$J,X)
93 Q
Note: See TracBrowser for help on using the repository browser.