| 1 | RGMTHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;08/20/01
 | 
|---|
| 2 |  ;;1.0;CLINCAL INFO RESOURCE NETWORK;**25**;30 Apr 99
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;Reference to XPAR based on supported IA #2263
 | 
|---|
| 5 |  ;Reference to %ZISH based on supported IA #2320
 | 
|---|
| 6 |  ;Reference to "VAFC HFS SCRATCH" supported by IA #3549
 | 
|---|
| 7 |  ;
 | 
|---|
| 8 |  Q
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 | HFS(LINETAG) ;
 | 
|---|
| 11 |  D HFSOPEN("RPC") I POP D  Q
 | 
|---|
| 12 |  .S ^TMP("RGMTHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_$$GET^XPAR("SYS","VAFC HFS SCRATCH")
 | 
|---|
| 13 |  .S ^TMP("RGMTHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEDGES."
 | 
|---|
| 14 |  U IO
 | 
|---|
| 15 |  D @LINETAG
 | 
|---|
| 16 |  D HFSCLOSE("RPC")
 | 
|---|
| 17 |  Q
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 | HFSOPEN(HANDLE) ; 
 | 
|---|
| 20 |  N RGMTDIR,RGMTFILE
 | 
|---|
| 21 |  S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
 | 
|---|
| 22 |  S RGMTFILE="RGMT"_DUZ_".DAT"
 | 
|---|
| 23 |  D OPEN^%ZISH(HANDLE,RGMTDIR,RGMTFILE,"W") Q:POP
 | 
|---|
| 24 |  S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 | HFSCLOSE(HANDLE) ; 
 | 
|---|
| 28 |  N RGMTDIR,RGMTFILE,RGMTDEL
 | 
|---|
| 29 |  D CLOSE^%ZISH(HANDLE)
 | 
|---|
| 30 |  K ^TMP("RGMTHFS",$J)
 | 
|---|
| 31 |  S RGMTDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH")
 | 
|---|
| 32 |  S RGMTFILE="RGMT"_DUZ_".DAT",RGMTDEL(RGMTFILE)=""
 | 
|---|
| 33 |  S X=$$FTG^%ZISH(RGMTDIR,RGMTFILE,$NAME(^TMP("RGMTHFS",$J,1)),3)
 | 
|---|
| 34 |  S X=$$DEL^%ZISH(RGMTDIR,$NA(RGMTDEL))
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 |  ; ------------------
 | 
|---|
| 37 | HFSGET(RM,GOTO) ;
 | 
|---|
| 38 |  ;RM=Right margin
 | 
|---|
| 39 |  S:'$G(RM) RM=80
 | 
|---|
| 40 |  N ZTQUEUED,RGMTHFS,RGMTSUB,RGMTIO
 | 
|---|
| 41 |  S RGMTHFS="RGMT_"_$J_".DAT",RGMTSUB="RGMTDATA"
 | 
|---|
| 42 |  D OPEN(.RM,.RGMTHFS,"W",.RGMTIO)
 | 
|---|
| 43 |  D @GOTO
 | 
|---|
| 44 |  D CLOSE(.RGMTRM,.RGMTHFS,.RGMTSUB,.RGMTIO)
 | 
|---|
| 45 |  Q
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 | OPEN(RGMTRM,RGMTHFS,RGMTMODE,RGMTIO) ; -- open WORKSTATION device
 | 
|---|
| 48 |  ;   RGMTRM: right margin
 | 
|---|
| 49 |  ;  RGMTHFS: host file name
 | 
|---|
| 50 |  ; RGMTMODE: open file in 'R'ead or 'W'rite mode
 | 
|---|
| 51 |  S ZTQUEUED="" K IOPAR
 | 
|---|
| 52 |  S IOP="OR WORKSTATION;"_$G(RGMTRM,80)
 | 
|---|
| 53 |  S %ZIS("HFSMODE")=RGMTMODE,%ZIS("HFSNAME")=RGMTHFS
 | 
|---|
| 54 |  D ^%ZIS K IOP,%ZIS
 | 
|---|
| 55 |  U IO S RGMTIO=IO
 | 
|---|
| 56 |  Q
 | 
|---|
| 57 |  ;
 | 
|---|
| 58 | CLOSE(RGMTRM,RGMTHFS,RGMTSUB,RGMTIO) ; -- close WORKSTATION device
 | 
|---|
| 59 |  ; RGMTSUB: unique subscript name for output 
 | 
|---|
| 60 |  I IO=RGMTIO D ^%ZISC
 | 
|---|
| 61 |  U IO
 | 
|---|
| 62 |  D USEHFS
 | 
|---|
| 63 |  U IO
 | 
|---|
| 64 |  Q
 | 
|---|
| 65 | USEHFS ; -- use host file to build global array
 | 
|---|
| 66 |  N IO,RGMTK,SECTION
 | 
|---|
| 67 |  S SECTION=0
 | 
|---|
| 68 |  S RGMTK=$$FTG^%ZISH(,RGMTHFS,$NA(^TMP($J,1)),2) I 'RGMTK Q
 | 
|---|
| 69 |  N RGMTRR S RGMTRR(RGMTHFS)=""
 | 
|---|
| 70 |  S RGMTK=$$DEL^%ZISH("",$NA(RGMTRR))
 | 
|---|
| 71 |  Q
 | 
|---|
| 72 | DSPPDAT(RGMT) ;
 | 
|---|
| 73 |  ; Output
 | 
|---|
| 74 |  ;   RGMT - array passed back with the display formatted PDAT call
 | 
|---|
| 75 |  N CNT,X,TXT
 | 
|---|
| 76 |  S CNT=0,X=0 F  S X=$O(^TMP("RGMTHFS",$J,X)) Q:'X  S TXT=^TMP("RGMTHFS",$J,X) D
 | 
|---|
| 77 |  . I $E(TXT,1,20)="Treating Facilities:" S RGMT(CNT)="" S CNT=CNT+1
 | 
|---|
| 78 |  . I $E(TXT,1,12)="Subscribers:" S RGMT(CNT)="" S CNT=CNT+1
 | 
|---|
| 79 |  . I $E(TXT,1,12)="ICN History:" S RGMT(CNT)="" S CNT=CNT+1
 | 
|---|
| 80 |  . I $E(TXT,1,13)="CMOR History:" S RGMT(CNT)="" S CNT=CNT+1
 | 
|---|
| 81 |  . I $E(TXT,1,28)="CMOR Change Request History:" S RGMT(CNT)="" S CNT=CNT+1
 | 
|---|
| 82 |  . I TXT'="" I $E(TXT,1,12)'="Enter RETURN" S RGMT(CNT)=^TMP("RGMTHFS",$J,X),CNT=CNT+1
 | 
|---|
| 83 |  Q
 | 
|---|
| 84 | ETOT ;
 | 
|---|
| 85 |  ;remove specific lines from ETOT global
 | 
|---|
| 86 |  M ^TMP("RGMTHFS1",$J)=^TMP("RGMTHFS",$J) K ^TMP("RGMTHFS",$J)
 | 
|---|
| 87 |  S CNT=1,X=0 F  S X=$O(^TMP("RGMTHFS1",$J,X)) Q:'X  S TXT=^TMP("RGMTHFS1",$J,X) D
 | 
|---|
| 88 |  . I $E(TXT,1,10)="...purging" Q
 | 
|---|
| 89 |  . I $E(TXT,1,11)="and deleted" Q
 | 
|---|
| 90 |  . I $E(TXT,1,12)="Data string:" Q
 | 
|---|
| 91 |  . I $E(TXT,1,10)="Site;Sta#;" Q
 | 
|---|
| 92 |  .S ^TMP("RGMTHFS",$J,CNT)=^TMP("RGMTHFS1",$J,X)
 | 
|---|
| 93 |  Q
 | 
|---|