source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCHFS.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1VAFCHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01
2 ;;5.3;Registration;**414,477**;Aug 13, 1993
3 ;;Routine uses the following supported IAs #2263, #2320, #2336, and #2992.
4HFS(LINETAG) ;
5 N VAFCDIR,VAFCFILE,POP
6 D HFSOPEN("RPC") I POP D Q
7 .S ^TMP("VAFCHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_VAFCDIR_" FILE "_VAFCFILE
8 .S ^TMP("VAFCHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEGES."
9 U IO
10 D @LINETAG
11 D HFSCLOSE("RPC")
12 ;M RESULTS=^TMP($J)
13 Q
14 ;
15HFSOPEN(HANDLE) ;
16 S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
17 S VAFCFILE="VAFC"_DUZ_".DAT"
18 S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
19 D OPEN^%ZISH(HANDLE,VAFCDIR,VAFCFILE,"W") Q:POP
20 Q
21 ;
22HFSCLOSE(HANDLE) ;
23 N VAFCDIR,VAFCFILE,VAFCDEL
24 D CLOSE^%ZISH(HANDLE)
25 K ^TMP("VAFCHFS",$J)
26 S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
27 S VAFCFILE="VAFC"_DUZ_".DAT",VAFCDEL(VAFCFILE)=""
28 S X=$$FTG^%ZISH(VAFCDIR,VAFCFILE,$NAME(^TMP("VAFCHFS",$J,1)),3)
29 S X=$$DEL^%ZISH(VAFCDIR,$NA(VAFCDEL))
30 Q
31 ;
32HFSGET(RM,GOTO) ;
33 ;RM=Right margin
34 S:'$G(RM) RM=80
35 N ZTQUEUED,VAFCHFS,VAFCSUB,VAFCIO
36 S VAFCHFS="VAFC_"_$J_".DAT",VAFCSUB="VAFCDATA"
37 D OPEN(.RM,.VAFCHFS,"W",.VAFCIO)
38 D @GOTO
39 D CLOSE(.VAFCRM,.VAFCHFS,.VAFCSUB,.VAFCIO)
40 Q
41 ;
42OPEN(VAFCRM,VAFCHFS,VAFCMODE,VAFCIO) ; -- open WORKSTATION device
43 ; VAFCRM: right margin
44 ; VAFCHFS: host file name
45 ; VAFCMODE: open file in 'R'ead or 'W'rite mode
46 S ZTQUEUED="" K IOPAR
47 S IOP="OR WORKSTATION;"_$G(VAFCRM,80)
48 S %ZIS("HFSMODE")=VAFCMODE,%ZIS("HFSNAME")=VAFCHFS
49 D ^%ZIS K IOP,%ZIS
50 U IO S VAFCIO=IO
51 Q
52 ;
53CLOSE(VAFCRM,VAFCHFS,VAFCSUB,VAFCIO) ; -- close WORKSTATION device
54 ; VAFCSUB: unique subscript name for output
55 I IO=VAFCIO D ^%ZISC
56 U IO
57 D USEHFS
58 U IO
59 Q
60USEHFS ; -- use host file to build global array
61 N IO,VAFCK,SECTION
62 S SECTION=0
63 S VAFCK=$$FTG^%ZISH(,VAFCHFS,$NA(^TMP($J,1)),2) I 'VAFCK Q
64 N VAFCRR S VAFCRR(VAFCHFS)=""
65 S VAFCK=$$DEL^%ZISH("",$NA(VAFCRR))
66 Q
67EDIT ;edit the HFS directory
68 D EDITPAR^XPAREDIT("VAFC HFS SCRATCH")
69 Q
70DSPPDAT(VAFC) ;
71 ; Output
72 ; VAFC - array passed back with the display formatted PDAT call
73 N CNT,X,TXT
74 S CNT=0,X=0 F S X=$O(^TMP("VAFCHFS",$J,X)) Q:'X S TXT=^TMP("VAFCHFS",$J,X) D I $S<3000 S VAFC(CNT)="*** QUERY TERMINATED DUE TO VOLUME OF DATA FOR SELECTED DATE RANGE ***" Q ;**477
75 . I $E(TXT,1,20)="Treating Facilities:" S VAFC(CNT)="" S CNT=CNT+1
76 . I $E(TXT,1,12)="Subscribers:" S VAFC(CNT)="" S CNT=CNT+1
77 . I $E(TXT,1,12)="ICN History:" S VAFC(CNT)="" S CNT=CNT+1
78 . I $E(TXT,1,13)="CMOR History:" S VAFC(CNT)="" S CNT=CNT+1
79 . I $E(TXT,1,28)="CMOR Change Request History:" S VAFC(CNT)="" S CNT=CNT+1
80 . I TXT'="" I $E(TXT,1,12)'="Enter RETURN" S VAFC(CNT)=^TMP("VAFCHFS",$J,X),CNT=CNT+1
81 K ^TMP("VAFCHFS",$J)
82 Q
83CREATE ;create entry in File #8989.51 for remote HFS functionality
84 N VAFC,VAFC1,ARRAY,Y,VAFCY
85 S VAFC=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
86 I VAFC>0 D
87 . K DIC,DA,DO,X,DIE,DR S DIC=8989.51,DIC(0)="X",X="VAFC HFS SCRATCH" D ^DIC
88 . S VAFCY=+Y L +^XTV(8989.51,VAFCY):5
89 . S DIE=DIC,DA=+Y S DR=".02///Scratch HFS Directory;.03///0;.05///Directory name;1.1///F;1.2///1:250;1.3///Enter in an OS level directory with read/write/edit/delete privileges.;30///1",DR(2,8989.513)=".01///1;.02///4.2" D ^DIE D
90 .. L -^XTV(8989.51,VAFCY)
91 .. K DIC,DA,DO,X,DIE,DR
92 . S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
93 . S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
94 . S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
95 . S ARRAY(1,3)="read/write/edit/delete privileges."
96 . S ARRAY(1,4)="Example:"
97 . S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
98 . S ARRAY(1,6)=" Directory AIJ$:[000000]"
99 . S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
100 . D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
101 I VAFC<1 D
102 . K FDA
103 . S FDA(1,8989.51,"+1,",.01)="VAFC HFS SCRATCH"
104 . S FDA(1,8989.51,"+1,",.02)="Scratch HFS Directory"
105 . S FDA(1,8989.51,"+1,",.03)=0
106 . S FDA(1,8989.51,"+1,",.05)="Directory name"
107 . S FDA(1,8989.51,"+1,",1.1)="F"
108 . S FDA(1,8989.51,"+1,",1.2)="1:250"
109 . S FDA(1,8989.51,"+1,",1.3)="Enter in an OS level directory with read/write/edit/delete privileges."
110 . S FDA(1,8989.513,"+2,+1,",.01)=1
111 . S FDA(1,8989.513,"+2,+1,",.02)="4.2"
112 . D UPDATE^DIE("","FDA(1)","FDAIEN") K FDA
113 . S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
114 . S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
115 . S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
116 . S ARRAY(1,3)="read/write/edit/delete privileges."
117 . S ARRAY(1,4)="Example:"
118 . S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
119 . S ARRAY(1,6)=" Directory AIJ$:[000000]"
120 . S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
121 . D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
122 D EDIT
123 Q
Note: See TracBrowser for help on using the repository browser.