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

VAFCHFS.m

Go to the documentation of this file.
  1. 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
  1. ;;Routine uses the following supported IAs #2263, #2320, #2336, and #2992.
  1. HFS(LINETAG) ;
  1. N VAFCDIR,VAFCFILE,POP
  1. D HFSOPEN("RPC") I POP D Q
  1. .S ^TMP("VAFCHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_VAFCDIR_" FILE "_VAFCFILE
  1. .S ^TMP("VAFCHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEGES."
  1. U IO
  1. D @LINETAG
  1. D HFSCLOSE("RPC")
  1. ;M RESULTS=^TMP($J)
  1. Q
  1. ;
  1. HFSOPEN(HANDLE) ;
  1. S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
  1. S VAFCFILE="VAFC"_DUZ_".DAT"
  1. S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
  1. D OPEN^%ZISH(HANDLE,VAFCDIR,VAFCFILE,"W") Q:POP
  1. Q
  1. ;
  1. HFSCLOSE(HANDLE) ;
  1. N VAFCDIR,VAFCFILE,VAFCDEL
  1. D CLOSE^%ZISH(HANDLE)
  1. K ^TMP("VAFCHFS",$J)
  1. S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
  1. S VAFCFILE="VAFC"_DUZ_".DAT",VAFCDEL(VAFCFILE)=""
  1. S X=$$FTG^%ZISH(VAFCDIR,VAFCFILE,$NAME(^TMP("VAFCHFS",$J,1)),3)
  1. S X=$$DEL^%ZISH(VAFCDIR,$NA(VAFCDEL))
  1. Q
  1. ;
  1. HFSGET(RM,GOTO) ;
  1. ;RM=Right margin
  1. S:'$G(RM) RM=80
  1. N ZTQUEUED,VAFCHFS,VAFCSUB,VAFCIO
  1. S VAFCHFS="VAFC_"_$J_".DAT",VAFCSUB="VAFCDATA"
  1. D OPEN(.RM,.VAFCHFS,"W",.VAFCIO)
  1. D @GOTO
  1. D CLOSE(.VAFCRM,.VAFCHFS,.VAFCSUB,.VAFCIO)
  1. Q
  1. ;
  1. OPEN(VAFCRM,VAFCHFS,VAFCMODE,VAFCIO) ; -- open WORKSTATION device
  1. ; VAFCRM: right margin
  1. ; VAFCHFS: host file name
  1. ; VAFCMODE: open file in 'R'ead or 'W'rite mode
  1. S ZTQUEUED="" K IOPAR
  1. S IOP="OR WORKSTATION;"_$G(VAFCRM,80)
  1. S %ZIS("HFSMODE")=VAFCMODE,%ZIS("HFSNAME")=VAFCHFS
  1. D ^%ZIS K IOP,%ZIS
  1. U IO S VAFCIO=IO
  1. Q
  1. ;
  1. CLOSE(VAFCRM,VAFCHFS,VAFCSUB,VAFCIO) ; -- close WORKSTATION device
  1. ; VAFCSUB: unique subscript name for output
  1. I IO=VAFCIO 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,VAFCK,SECTION
  1. S SECTION=0
  1. S VAFCK=$$FTG^%ZISH(,VAFCHFS,$NA(^TMP($J,1)),2) I 'VAFCK Q
  1. N VAFCRR S VAFCRR(VAFCHFS)=""
  1. S VAFCK=$$DEL^%ZISH("",$NA(VAFCRR))
  1. Q
  1. EDIT ;edit the HFS directory
  1. D EDITPAR^XPAREDIT("VAFC HFS SCRATCH")
  1. Q
  1. DSPPDAT(VAFC) ;
  1. ; Output
  1. ; VAFC - array passed back with the display formatted PDAT call
  1. N CNT,X,TXT,OVF
  1. 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
  1. . I $E(TXT,1,20)="Treating Facilities:" S VAFC(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,12)="Subscribers:" S VAFC(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,12)="ICN History:" S VAFC(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,13)="CMOR History:" S VAFC(CNT)="" S CNT=CNT+1
  1. . I $E(TXT,1,28)="CMOR Change Request History:" S VAFC(CNT)="" S CNT=CNT+1
  1. . I TXT'="",$E(TXT,1,12)'="Enter RETURN" D
  1. .. S VAFC(CNT)=^TMP("VAFCHFS",$J,X)
  1. .. ;**1059,Story 11114,11118 (mko): Account for lines > 255 characters; overflow is in "OVF" nodes.
  1. .. 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))
  1. .. S CNT=CNT+1
  1. K ^TMP("VAFCHFS",$J)
  1. Q
  1. CREATE ;create entry in File #8989.51 for remote HFS functionality
  1. N VAFC,VAFC1,ARRAY,Y,VAFCY
  1. S VAFC=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
  1. I VAFC>0 D
  1. . K DIC,DA,DO,X,DIE,DR S DIC=8989.51,DIC(0)="X",X="VAFC HFS SCRATCH" D ^DIC
  1. . S VAFCY=+Y L +^XTV(8989.51,VAFCY):5
  1. . 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
  1. .. L -^XTV(8989.51,VAFCY)
  1. .. K DIC,DA,DO,X,DIE,DR
  1. . S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
  1. . S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
  1. . S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
  1. . S ARRAY(1,3)="read/write/edit/delete privileges."
  1. . S ARRAY(1,4)="Example:"
  1. . S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
  1. . S ARRAY(1,6)=" Directory AIJ$:[000000]"
  1. . S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
  1. . D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
  1. I VAFC<1 D
  1. . K FDA
  1. . S FDA(1,8989.51,"+1,",.01)="VAFC HFS SCRATCH"
  1. . S FDA(1,8989.51,"+1,",.02)="Scratch HFS Directory"
  1. . S FDA(1,8989.51,"+1,",.03)=0
  1. . S FDA(1,8989.51,"+1,",.05)="Directory name"
  1. . S FDA(1,8989.51,"+1,",1.1)="F"
  1. . S FDA(1,8989.51,"+1,",1.2)="1:250"
  1. . S FDA(1,8989.51,"+1,",1.3)="Enter in an OS level directory with read/write/edit/delete privileges."
  1. . S FDA(1,8989.513,"+2,+1,",.01)=1
  1. . S FDA(1,8989.513,"+2,+1,",.02)="4.2"
  1. . D UPDATE^DIE("","FDA(1)","FDAIEN") K FDA
  1. . S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR")
  1. . S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel"
  1. . S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with"
  1. . S ARRAY(1,3)="read/write/edit/delete privileges."
  1. . S ARRAY(1,4)="Example:"
  1. . S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot"
  1. . S ARRAY(1,6)=" Directory AIJ$:[000000]"
  1. . S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)"
  1. . D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)")
  1. D EDIT
  1. Q