RGMTHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01
;;1.0;CLINCAL INFO RESOURCE NETWORK;**25**;30 Apr 99
;
;Reference to XPAR based on supported IA #2263
;Reference to %ZISH based on supported IA #2320
;Reference to "VAFC HFS SCRATCH" supported by IA #3549
;
Q
;
HFS(LINETAG) ;
D HFSOPEN("RPC") I POP D Q
.S ^TMP("RGMTHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_$$GET^XPAR("SYS","VAFC HFS SCRATCH")
.S ^TMP("RGMTHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEDGES."
U IO
D @LINETAG
D HFSCLOSE("RPC")
Q
;
HFSOPEN(HANDLE) ;
N RGMTDIR,RGMTFILE
S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
S RGMTFILE="RGMT"_DUZ_".DAT"
D OPEN^%ZISH(HANDLE,RGMTDIR,RGMTFILE,"W") Q:POP
S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
Q
;
HFSCLOSE(HANDLE) ;
N RGMTDIR,RGMTFILE,RGMTDEL
D CLOSE^%ZISH(HANDLE)
K ^TMP("RGMTHFS",$J)
S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
S RGMTFILE="RGMT"_DUZ_".DAT",RGMTDEL(RGMTFILE)=""
S X=$$FTG^%ZISH(RGMTDIR,RGMTFILE,$NAME(^TMP("RGMTHFS",$J,1)),3)
S X=$$DEL^%ZISH(RGMTDIR,$NA(RGMTDEL))
Q
; ------------------
HFSGET(RM,GOTO) ;
;RM=Right margin
S:'$G(RM) RM=80
N ZTQUEUED,RGMTHFS,RGMTSUB,RGMTIO
S RGMTHFS="RGMT_"_$J_".DAT",RGMTSUB="RGMTDATA"
D OPEN(.RM,.RGMTHFS,"W",.RGMTIO)
D @GOTO
D CLOSE(.RGMTRM,.RGMTHFS,.RGMTSUB,.RGMTIO)
Q
;
OPEN(RGMTRM,RGMTHFS,RGMTMODE,RGMTIO) ; -- open WORKSTATION device
; RGMTRM: right margin
; RGMTHFS: host file name
; RGMTMODE: open file in 'R'ead or 'W'rite mode
S ZTQUEUED="" K IOPAR
S IOP="OR WORKSTATION;"_$G(RGMTRM,80)
S %ZIS("HFSMODE")=RGMTMODE,%ZIS("HFSNAME")=RGMTHFS
D ^%ZIS K IOP,%ZIS
U IO S RGMTIO=IO
Q
;
CLOSE(RGMTRM,RGMTHFS,RGMTSUB,RGMTIO) ; -- close WORKSTATION device
; RGMTSUB: unique subscript name for output
I IO=RGMTIO D ^%ZISC
U IO
D USEHFS
U IO
Q
USEHFS ; -- use host file to build global array
N IO,RGMTK,SECTION
S SECTION=0
S RGMTK=$$FTG^%ZISH(,RGMTHFS,$NA(^TMP($J,1)),2) I 'RGMTK Q
N RGMTRR S RGMTRR(RGMTHFS)=""
S RGMTK=$$DEL^%ZISH("",$NA(RGMTRR))
Q
DSPPDAT(RGMT) ;
; Output
; RGMT - array passed back with the display formatted PDAT call
N CNT,X,TXT
S CNT=0,X=0 F S X=$O(^TMP("RGMTHFS",$J,X)) Q:'X S TXT=^TMP("RGMTHFS",$J,X) D
. I $E(TXT,1,20)="Treating Facilities:" S RGMT(CNT)="" S CNT=CNT+1
. I $E(TXT,1,12)="Subscribers:" S RGMT(CNT)="" S CNT=CNT+1
. I $E(TXT,1,12)="ICN History:" S RGMT(CNT)="" S CNT=CNT+1
. I $E(TXT,1,13)="CMOR History:" S RGMT(CNT)="" S CNT=CNT+1
. I $E(TXT,1,28)="CMOR Change Request History:" S RGMT(CNT)="" S CNT=CNT+1
. I TXT'="" I $E(TXT,1,12)'="Enter RETURN" S RGMT(CNT)=^TMP("RGMTHFS",$J,X),CNT=CNT+1
Q
ETOT ;
;remove specific lines from ETOT global
M ^TMP("RGMTHFS1",$J)=^TMP("RGMTHFS",$J) K ^TMP("RGMTHFS",$J)
S CNT=1,X=0 F S X=$O(^TMP("RGMTHFS1",$J,X)) Q:'X S TXT=^TMP("RGMTHFS1",$J,X) D
. I $E(TXT,1,10)="...purging" Q
. I $E(TXT,1,11)="and deleted" Q
. I $E(TXT,1,12)="Data string:" Q
. I $E(TXT,1,10)="Site;Sta#;" Q
.S ^TMP("RGMTHFS",$J,CNT)=^TMP("RGMTHFS1",$J,X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTHFS 3089 printed Sep 23, 2025@19:18:18 Page 2
RGMTHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01
+1 ;;1.0;CLINCAL INFO RESOURCE NETWORK;**25**;30 Apr 99
+2 ;
+3 ;Reference to XPAR based on supported IA #2263
+4 ;Reference to %ZISH based on supported IA #2320
+5 ;Reference to "VAFC HFS SCRATCH" supported by IA #3549
+6 ;
+7 QUIT
+8 ;
HFS(LINETAG) ;
+1 DO HFSOPEN("RPC")
IF POP
Begin DoDot:1
+2 SET ^TMP("RGMTHFS",$JOB,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_$$GET^XPAR("SYS","VAFC HFS SCRATCH")
+3 SET ^TMP("RGMTHFS",$JOB,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEDGES."
End DoDot:1
QUIT
+4 USE IO
+5 DO @LINETAG
+6 DO HFSCLOSE("RPC")
+7 QUIT
+8 ;
HFSOPEN(HANDLE) ;
+1 NEW RGMTDIR,RGMTFILE
+2 SET RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
+3 SET RGMTFILE="RGMT"_DUZ_".DAT"
+4 DO OPEN^%ZISH(HANDLE,RGMTDIR,RGMTFILE,"W")
if POP
QUIT
+5 SET IOM=132
SET IOSL=99999
SET IOST="P-DUMMY"
SET IOF=""""""
+6 QUIT
+7 ;
HFSCLOSE(HANDLE) ;
+1 NEW RGMTDIR,RGMTFILE,RGMTDEL
+2 DO CLOSE^%ZISH(HANDLE)
+3 KILL ^TMP("RGMTHFS",$JOB)
+4 SET RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
+5 SET RGMTFILE="RGMT"_DUZ_".DAT"
SET RGMTDEL(RGMTFILE)=""
+6 SET X=$$FTG^%ZISH(RGMTDIR,RGMTFILE,$NAME(^TMP("RGMTHFS",$JOB,1)),3)
+7 SET X=$$DEL^%ZISH(RGMTDIR,$NAME(RGMTDEL))
+8 QUIT
+9 ; ------------------
HFSGET(RM,GOTO) ;
+1 ;RM=Right margin
+2 if '$GET(RM)
SET RM=80
+3 NEW ZTQUEUED,RGMTHFS,RGMTSUB,RGMTIO
+4 SET RGMTHFS="RGMT_"_$JOB_".DAT"
SET RGMTSUB="RGMTDATA"
+5 DO OPEN(.RM,.RGMTHFS,"W",.RGMTIO)
+6 DO @GOTO
+7 DO CLOSE(.RGMTRM,.RGMTHFS,.RGMTSUB,.RGMTIO)
+8 QUIT
+9 ;
OPEN(RGMTRM,RGMTHFS,RGMTMODE,RGMTIO) ; -- open WORKSTATION device
+1 ; RGMTRM: right margin
+2 ; RGMTHFS: host file name
+3 ; RGMTMODE: open file in 'R'ead or 'W'rite mode
+4 SET ZTQUEUED=""
KILL IOPAR
+5 SET IOP="OR WORKSTATION;"_$GET(RGMTRM,80)
+6 SET %ZIS("HFSMODE")=RGMTMODE
SET %ZIS("HFSNAME")=RGMTHFS
+7 DO ^%ZIS
KILL IOP,%ZIS
+8 USE IO
SET RGMTIO=IO
+9 QUIT
+10 ;
CLOSE(RGMTRM,RGMTHFS,RGMTSUB,RGMTIO) ; -- close WORKSTATION device
+1 ; RGMTSUB: unique subscript name for output
+2 IF IO=RGMTIO
DO ^%ZISC
+3 USE IO
+4 DO USEHFS
+5 USE IO
+6 QUIT
USEHFS ; -- use host file to build global array
+1 NEW IO,RGMTK,SECTION
+2 SET SECTION=0
+3 SET RGMTK=$$FTG^%ZISH(,RGMTHFS,$NAME(^TMP($JOB,1)),2)
IF 'RGMTK
QUIT
+4 NEW RGMTRR
SET RGMTRR(RGMTHFS)=""
+5 SET RGMTK=$$DEL^%ZISH("",$NAME(RGMTRR))
+6 QUIT
DSPPDAT(RGMT) ;
+1 ; Output
+2 ; RGMT - array passed back with the display formatted PDAT call
+3 NEW CNT,X,TXT
+4 SET CNT=0
SET X=0
FOR
SET X=$ORDER(^TMP("RGMTHFS",$JOB,X))
if 'X
QUIT
SET TXT=^TMP("RGMTHFS",$JOB,X)
Begin DoDot:1
+5 IF $EXTRACT(TXT,1,20)="Treating Facilities:"
SET RGMT(CNT)=""
SET CNT=CNT+1
+6 IF $EXTRACT(TXT,1,12)="Subscribers:"
SET RGMT(CNT)=""
SET CNT=CNT+1
+7 IF $EXTRACT(TXT,1,12)="ICN History:"
SET RGMT(CNT)=""
SET CNT=CNT+1
+8 IF $EXTRACT(TXT,1,13)="CMOR History:"
SET RGMT(CNT)=""
SET CNT=CNT+1
+9 IF $EXTRACT(TXT,1,28)="CMOR Change Request History:"
SET RGMT(CNT)=""
SET CNT=CNT+1
+10 IF TXT'=""
IF $EXTRACT(TXT,1,12)'="Enter RETURN"
SET RGMT(CNT)=^TMP("RGMTHFS",$JOB,X)
SET CNT=CNT+1
End DoDot:1
+11 QUIT
ETOT ;
+1 ;remove specific lines from ETOT global
+2 MERGE ^TMP("RGMTHFS1",$JOB)=^TMP("RGMTHFS",$JOB)
KILL ^TMP("RGMTHFS",$JOB)
+3 SET CNT=1
SET X=0
FOR
SET X=$ORDER(^TMP("RGMTHFS1",$JOB,X))
if 'X
QUIT
SET TXT=^TMP("RGMTHFS1",$JOB,X)
Begin DoDot:1
+4 IF $EXTRACT(TXT,1,10)="...purging"
QUIT
+5 IF $EXTRACT(TXT,1,11)="and deleted"
QUIT
+6 IF $EXTRACT(TXT,1,12)="Data string:"
QUIT
+7 IF $EXTRACT(TXT,1,10)="Site;Sta#;"
QUIT
+8 SET ^TMP("RGMTHFS",$JOB,CNT)=^TMP("RGMTHFS1",$JOB,X)
End DoDot:1
+9 QUIT
