Routine: VAFCHFS

VAFCHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01

 ;;5.3;Registration;**414,477**;Aug 13, 1993

 ;;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)

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

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))

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)

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

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

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))

EDIT ;edit the HFS directory

 D EDITPAR^XPAREDIT("VAFC HFS SCRATCH")

DSPPDAT(VAFC) ;

 ; Output

 ;   VAFC - array passed back with the display formatted PDAT call

 N CNT,X,TXT

 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'="" I $E(TXT,1,12)'="Enter RETURN" S VAFC(CNT)=^TMP("VAFCHFS",$J,X),CNT=CNT+1

 K ^TMP("VAFCHFS",$J)

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

VAFCHFS   ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01

 +1       ;;5.3;Registration;**414,477**;Aug 13, 1993

 +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

 +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"

                           SET VAFC(CNT)=^TMP("VAFCHFS",$JOB,X)

                           SET CNT=CNT+1

               End DoDot:1

               IF $STORAGE<3000

                   SET VAFC(CNT)="*** QUERY TERMINATED DUE TO VOLUME OF DATA FOR SELECTED DATE RANGE ***"

                   QUIT

 +11       KILL ^TMP("VAFCHFS",$JOB)

 +12       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

VAFCHFS.m