- 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 Jan 18, 2025@04:02:24 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