VAFCHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;13 Sep 2021 9:58 AM
;;5.3;Registration;**414,477,1059**;Aug 13, 1993;Build 6
;;Routine uses the following supported IAs #2263, #2320, #2336, and #2992.
HFS(LINETAG) ;
N VAFCDIR,VAFCFILE,POP
D HFSOPEN("RPC") I POP D Q
.S ^TMP("VAFCHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_VAFCDIR_" FILE "_VAFCFILE
.S ^TMP("VAFCHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEGES."
U IO
D @LINETAG
D HFSCLOSE("RPC")
;M RESULTS=^TMP($J)
Q
;
HFSOPEN(HANDLE) ;
S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
S VAFCFILE="VAFC"_DUZ_".DAT"
S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
D OPEN^%ZISH(HANDLE,VAFCDIR,VAFCFILE,"W") Q:POP
Q
;
HFSCLOSE(HANDLE) ;
N VAFCDIR,VAFCFILE,VAFCDEL
D CLOSE^%ZISH(HANDLE)
K ^TMP("VAFCHFS",$J)
S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
S VAFCFILE="VAFC"_DUZ_".DAT",VAFCDEL(VAFCFILE)=""
S X=$$FTG^%ZISH(VAFCDIR,VAFCFILE,$NAME(^TMP("VAFCHFS",$J,1)),3)
S X=$$DEL^%ZISH(VAFCDIR,$NA(VAFCDEL))
Q
;
HFSGET(RM,GOTO) ;
;RM=Right margin
S:'$G(RM) RM=80
N ZTQUEUED,VAFCHFS,VAFCSUB,VAFCIO
S VAFCHFS="VAFC_"_$J_".DAT",VAFCSUB="VAFCDATA"
D OPEN(.RM,.VAFCHFS,"W",.VAFCIO)
D @GOTO
D CLOSE(.VAFCRM,.VAFCHFS,.VAFCSUB,.VAFCIO)
Q
;
OPEN(VAFCRM,VAFCHFS,VAFCMODE,VAFCIO) ; -- open WORKSTATION device
; VAFCRM: right margin
; VAFCHFS: host file name
; VAFCMODE: open file in 'R'ead or 'W'rite mode
S ZTQUEUED="" K IOPAR
S IOP="OR WORKSTATION;"_$G(VAFCRM,80)
S %ZIS("HFSMODE")=VAFCMODE,%ZIS("HFSNAME")=VAFCHFS
D ^%ZIS K IOP,%ZIS
U IO S VAFCIO=IO
Q
;
CLOSE(VAFCRM,VAFCHFS,VAFCSUB,VAFCIO) ; -- close WORKSTATION device
; VAFCSUB: unique subscript name for output
I IO=VAFCIO D ^%ZISC
U IO
D USEHFS
U IO
Q
USEHFS ; -- use host file to build global array
N IO,VAFCK,SECTION
S SECTION=0
S VAFCK=$$FTG^%ZISH(,VAFCHFS,$NA(^TMP($J,1)),2) I 'VAFCK Q
N VAFCRR S VAFCRR(VAFCHFS)=""
S VAFCK=$$DEL^%ZISH("",$NA(VAFCRR))
Q
EDIT ;edit the HFS directory
D EDITPAR^XPAREDIT("VAFC HFS SCRATCH")
Q
DSPPDAT(VAFC) ;
; Output
; VAFC - array passed back with the display formatted PDAT call
N CNT,X,TXT,OVF
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
. I $E(TXT,1,20)="Treating Facilities:" S VAFC(CNT)="" S CNT=CNT+1
. I $E(TXT,1,12)="Subscribers:" S VAFC(CNT)="" S CNT=CNT+1
. I $E(TXT,1,12)="ICN History:" S VAFC(CNT)="" S CNT=CNT+1
. I $E(TXT,1,13)="CMOR History:" S VAFC(CNT)="" S CNT=CNT+1
. I $E(TXT,1,28)="CMOR Change Request History:" S VAFC(CNT)="" S CNT=CNT+1
. I TXT'="",$E(TXT,1,12)'="Enter RETURN" D
.. S VAFC(CNT)=^TMP("VAFCHFS",$J,X)
.. ;**1059,Story 11114,11118 (mko): Account for lines > 255 characters; overflow is in "OVF" nodes.
.. S OVF="" F S OVF=$O(^TMP("VAFCHFS",$J,X,"OVF",OVF)) Q:'OVF S VAFC(CNT)=VAFC(CNT)_$G(^TMP("VAFCHFS",$J,X,"OVF",OVF))
.. S CNT=CNT+1
K ^TMP("VAFCHFS",$J)
Q
CREATE ;create entry in File #8989.51 for remote HFS functionality
N VAFC,VAFC1,ARRAY,Y,VAFCY
S VAFC=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
I VAFC>0 D
. K DIC,DA,DO,X,DIE,DR S DIC=8989.51,DIC(0)="X",X="VAFC HFS SCRATCH" D ^DIC
. S VAFCY=+Y L +^XTV(8989.51,VAFCY):5
. 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
.. L -^XTV(8989.51,VAFCY)
.. K DIC,DA,DO,X,DIE,DR
. S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
. S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
. S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
. S ARRAY(1,3)="read/write/edit/delete privileges."
. S ARRAY(1,4)="Example:"
. S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
. S ARRAY(1,6)=" Directory AIJ$:[000000]"
. S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
. D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
I VAFC<1 D
. K FDA
. S FDA(1,8989.51,"+1,",.01)="VAFC HFS SCRATCH"
. S FDA(1,8989.51,"+1,",.02)="Scratch HFS Directory"
. S FDA(1,8989.51,"+1,",.03)=0
. S FDA(1,8989.51,"+1,",.05)="Directory name"
. S FDA(1,8989.51,"+1,",1.1)="F"
. S FDA(1,8989.51,"+1,",1.2)="1:250"
. S FDA(1,8989.51,"+1,",1.3)="Enter in an OS level directory with read/write/edit/delete privileges."
. S FDA(1,8989.513,"+2,+1,",.01)=1
. S FDA(1,8989.513,"+2,+1,",.02)="4.2"
. D UPDATE^DIE("","FDA(1)","FDAIEN") K FDA
. S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
. S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
. S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
. S ARRAY(1,3)="read/write/edit/delete privileges."
. S ARRAY(1,4)="Example:"
. S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
. S ARRAY(1,6)=" Directory AIJ$:[000000]"
. S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
. D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
D EDIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCHFS 5280 printed Nov 22, 2024@18:11:42 Page 2
VAFCHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;13 Sep 2021 9:58 AM
+1 ;;5.3;Registration;**414,477,1059**;Aug 13, 1993;Build 6
+2 ;;Routine uses the following supported IAs #2263, #2320, #2336, and #2992.
HFS(LINETAG) ;
+1 NEW VAFCDIR,VAFCFILE,POP
+2 DO HFSOPEN("RPC")
IF POP
Begin DoDot:1
+3 SET ^TMP("VAFCHFS",$JOB,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_VAFCDIR_" FILE "_VAFCFILE
+4 SET ^TMP("VAFCHFS",$JOB,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEGES."
End DoDot:1
QUIT
+5 USE IO
+6 DO @LINETAG
+7 DO HFSCLOSE("RPC")
+8 ;M RESULTS=^TMP($J)
+9 QUIT
+10 ;
HFSOPEN(HANDLE) ;
+1 SET VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
+2 SET VAFCFILE="VAFC"_DUZ_".DAT"
+3 SET IOM=132
SET IOSL=99999
SET IOST="P-DUMMY"
SET IOF=""""""
+4 DO OPEN^%ZISH(HANDLE,VAFCDIR,VAFCFILE,"W")
if POP
QUIT
+5 QUIT
+6 ;
HFSCLOSE(HANDLE) ;
+1 NEW VAFCDIR,VAFCFILE,VAFCDEL
+2 DO CLOSE^%ZISH(HANDLE)
+3 KILL ^TMP("VAFCHFS",$JOB)
+4 SET VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
+5 SET VAFCFILE="VAFC"_DUZ_".DAT"
SET VAFCDEL(VAFCFILE)=""
+6 SET X=$$FTG^%ZISH(VAFCDIR,VAFCFILE,$NAME(^TMP("VAFCHFS",$JOB,1)),3)
+7 SET X=$$DEL^%ZISH(VAFCDIR,$NAME(VAFCDEL))
+8 QUIT
+9 ;
HFSGET(RM,GOTO) ;
+1 ;RM=Right margin
+2 if '$GET(RM)
SET RM=80
+3 NEW ZTQUEUED,VAFCHFS,VAFCSUB,VAFCIO
+4 SET VAFCHFS="VAFC_"_$JOB_".DAT"
SET VAFCSUB="VAFCDATA"
+5 DO OPEN(.RM,.VAFCHFS,"W",.VAFCIO)
+6 DO @GOTO
+7 DO CLOSE(.VAFCRM,.VAFCHFS,.VAFCSUB,.VAFCIO)
+8 QUIT
+9 ;
OPEN(VAFCRM,VAFCHFS,VAFCMODE,VAFCIO) ; -- open WORKSTATION device
+1 ; VAFCRM: right margin
+2 ; VAFCHFS: host file name
+3 ; VAFCMODE: open file in 'R'ead or 'W'rite mode
+4 SET ZTQUEUED=""
KILL IOPAR
+5 SET IOP="OR WORKSTATION;"_$GET(VAFCRM,80)
+6 SET %ZIS("HFSMODE")=VAFCMODE
SET %ZIS("HFSNAME")=VAFCHFS
+7 DO ^%ZIS
KILL IOP,%ZIS
+8 USE IO
SET VAFCIO=IO
+9 QUIT
+10 ;
CLOSE(VAFCRM,VAFCHFS,VAFCSUB,VAFCIO) ; -- close WORKSTATION device
+1 ; VAFCSUB: unique subscript name for output
+2 IF IO=VAFCIO
DO ^%ZISC
+3 USE IO
+4 DO USEHFS
+5 USE IO
+6 QUIT
USEHFS ; -- use host file to build global array
+1 NEW IO,VAFCK,SECTION
+2 SET SECTION=0
+3 SET VAFCK=$$FTG^%ZISH(,VAFCHFS,$NAME(^TMP($JOB,1)),2)
IF 'VAFCK
QUIT
+4 NEW VAFCRR
SET VAFCRR(VAFCHFS)=""
+5 SET VAFCK=$$DEL^%ZISH("",$NAME(VAFCRR))
+6 QUIT
EDIT ;edit the HFS directory
+1 DO EDITPAR^XPAREDIT("VAFC HFS SCRATCH")
+2 QUIT
DSPPDAT(VAFC) ;
+1 ; Output
+2 ; VAFC - array passed back with the display formatted PDAT call
+3 NEW CNT,X,TXT,OVF
+4 ;**477
SET CNT=0
SET X=0
FOR
SET X=$ORDER(^TMP("VAFCHFS",$JOB,X))
if 'X
QUIT
SET TXT=^TMP("VAFCHFS",$JOB,X)
Begin DoDot:1
+5 IF $EXTRACT(TXT,1,20)="Treating Facilities:"
SET VAFC(CNT)=""
SET CNT=CNT+1
+6 IF $EXTRACT(TXT,1,12)="Subscribers:"
SET VAFC(CNT)=""
SET CNT=CNT+1
+7 IF $EXTRACT(TXT,1,12)="ICN History:"
SET VAFC(CNT)=""
SET CNT=CNT+1
+8 IF $EXTRACT(TXT,1,13)="CMOR History:"
SET VAFC(CNT)=""
SET CNT=CNT+1
+9 IF $EXTRACT(TXT,1,28)="CMOR Change Request History:"
SET VAFC(CNT)=""
SET CNT=CNT+1
+10 IF TXT'=""
IF $EXTRACT(TXT,1,12)'="Enter RETURN"
Begin DoDot:2
+11 SET VAFC(CNT)=^TMP("VAFCHFS",$JOB,X)
+12 ;**1059,Story 11114,11118 (mko): Account for lines > 255 characters; overflow is in "OVF" nodes.
+13 SET OVF=""
FOR
SET OVF=$ORDER(^TMP("VAFCHFS",$JOB,X,"OVF",OVF))
if 'OVF
QUIT
SET VAFC(CNT)=VAFC(CNT)_$GET(^TMP("VAFCHFS",$JOB,X,"OVF",OVF))
+14 SET CNT=CNT+1
End DoDot:2
End DoDot:1
IF $STORAGE<3000
SET VAFC(CNT)="*** QUERY TERMINATED DUE TO VOLUME OF DATA FOR SELECTED DATE RANGE ***"
QUIT
+15 KILL ^TMP("VAFCHFS",$JOB)
+16 QUIT
CREATE ;create entry in File #8989.51 for remote HFS functionality
+1 NEW VAFC,VAFC1,ARRAY,Y,VAFCY
+2 SET VAFC=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
+3 IF VAFC>0
Begin DoDot:1
+4 KILL DIC,DA,DO,X,DIE,DR
SET DIC=8989.51
SET DIC(0)="X"
SET X="VAFC HFS SCRATCH"
DO ^DIC
+5 SET VAFCY=+Y
LOCK +^XTV(8989.51,VAFCY):5
+6 SET DIE=DIC
SET DA=+Y
SET 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"
SET DR(2,8989.513)=".01///1;.02///4.2"
DO ^DIE
Begin DoDot:2
+7 LOCK -^XTV(8989.51,VAFCY)
+8 KILL DIC,DA,DO,X,DIE,DR
End DoDot:2
+9 SET VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
+10 SET ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
+11 SET ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
+12 SET ARRAY(1,3)="read/write/edit/delete privileges."
+13 SET ARRAY(1,4)="Example:"
+14 SET ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
+15 SET ARRAY(1,6)=" Directory AIJ$:[000000]"
+16 SET ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
+17 DO WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
End DoDot:1
+18 IF VAFC<1
Begin DoDot:1
+19 KILL FDA
+20 SET FDA(1,8989.51,"+1,",.01)="VAFC HFS SCRATCH"
+21 SET FDA(1,8989.51,"+1,",.02)="Scratch HFS Directory"
+22 SET FDA(1,8989.51,"+1,",.03)=0
+23 SET FDA(1,8989.51,"+1,",.05)="Directory name"
+24 SET FDA(1,8989.51,"+1,",1.1)="F"
+25 SET FDA(1,8989.51,"+1,",1.2)="1:250"
+26 SET FDA(1,8989.51,"+1,",1.3)="Enter in an OS level directory with read/write/edit/delete privileges."
+27 SET FDA(1,8989.513,"+2,+1,",.01)=1
+28 SET FDA(1,8989.513,"+2,+1,",.02)="4.2"
+29 DO UPDATE^DIE("","FDA(1)","FDAIEN")
KILL FDA
+30 SET VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
+31 SET ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
+32 SET ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
+33 SET ARRAY(1,3)="read/write/edit/delete privileges."
+34 SET ARRAY(1,4)="Example:"
+35 SET ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
+36 SET ARRAY(1,6)=" Directory AIJ$:[000000]"
+37 SET ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
+38 DO WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
End DoDot:1
+39 DO EDIT
+40 QUIT
