- 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 Jan 18, 2025@02:43:33 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