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

ACRFLM.m

Go to the documentation of this file. 
  1. ACRFLM ;IHS/OIRM/DSD/THL,AEF - LIST MANAGER API'S ; [ 09/22/2005   4:18 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13,19**;NOV 05, 2001
  1.  ;; ;
  1. DOC ;Documentation APIs for ACRLM  Generic Display
  1.  ;This utility uses the Veterans Administration List Manager (VALM)
  1.  ;
  1.  ; APIs
  1.  ;
  1.  ; FILE^ACRFLM("Directory","File Name")   Displays file indicated
  1.  ;
  1.  ; SFILE^ACRFLM                           Selection of host file
  1.  ;                                      for display
  1.  ;
  1.  ; VIEWR^ACRFLM("TAG^ROUTINE","Header")   Displays printout of the
  1.  ;                                      routine. (non - FM, using IO)
  1.  ; VIEWD^ACRFLM("Tag^Routine","Header")   Displays printout of the
  1.  ;                                      routine. (FM - using EN1^DIP)
  1.  ; DIQ^ACRFLM("DIC","DA")                 Displays EN1^DIQ for the DIC,DA
  1.  ; ARRAY^ACRFLM("array(","Header")        Displays the array(..,n,0)
  1.  ;                                      (%RCR notation)
  1.  ;
  1.  ;
  1. EN ; -- main entry point for ACR DISPLAY
  1.  D EN^VALM("ACR DISPLAY")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  I ACRHDR]"" S VALMHDR(1)=ACRHDR
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1. MARKERS I $G(ACRLMARK) F I=10:10 Q:'$D(@VALMAR@(I))  D
  1.  . F J=10:10:80 D CNTRL^VALM10(I,J,1,IORVON,IORVOFF)
  1.  K ACRLMARK
  1.  S VALMCNT=$O(^TMP("ACRLM",$J,+$G(ACRNODE),""),-1)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?"
  1.  D DISP^XQORM1
  1.  W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("ACRLM",$J,+$G(ACRNODE))
  1. K ;
  1.  K ACRAR,ACRDIR,ACRFL,ACRFN,ACRHDR,ACRI,ACRROU,ACRDIR
  1.  I '$G(XQORS) D CLEAR^VALM1
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. FILE(ACRDIR,ACRFN)    ;PEP pull up a file into the TMP global for display
  1.  I '$D(ACRHDR) S ACRHDR=""
  1.  N Y,X,I,ACRNODE
  1.  S ACRNODE=$G(XQORS)+1
  1.  S Y=$$OPEN^%ZISH(ACRDIR,ACRFN,"R")
  1.  I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",ACRDIR,ACRFN,"'." G EFILE
  1.  K ^TMP("ACRLM",$J,+$G(ACRNODE))
  1.  ;THE READ STATEMENT BELOW IS A READ FROM A HOST FILE WHICH REQUIRES A
  1.  ;DIRECT READ VS AN FM CALL
  1.  F I=1:1 U IO R X:DTIME S X=$$STRIP(X) S ^TMP("ACRLM",$J,+$G(ACRNODE),I,0)=X Q:$$STATUS^%ZISH=-1   ;DIRECT READ FROM UNIX FILE
  1.  ;D ^%ZISC                                     ;ACR*2.1*13.02 IM13574
  1.  D CLOSE^%ZISH("")                             ;ACR*2.1*13.02 IM13574
  1.  D EN
  1.  K ^TMP("ACRLM",$J,+$G(ACRNODE))
  1. EFILE ;
  1.  Q
  1.  ;
  1. VIEWR(ACRROU,ACRHDR)         ;PEP USING ACRROU print to a host file for viewing
  1.  I '$D(ACRHDR) S ACRHDR=""
  1.  U IO(0)
  1.  ;S Y=$$PWD^%ZISH(.ACRDIR)      ;ACR*2.1*19.03 IM17636
  1.  ;S ACRDIR=$S($G(ACRDIR(1))]"":ACRDIR(1),1:"/usr/spool/uucppublic/") ;ACR*2.1*13.06 IM14144
  1.  S ACRDEF=$$ARMSDIR^ACRFSYS(1)  ;ACR*2.1*13.06 IM14144
  1.  Q:ACRDEF']""                   ;ACR*2.1*13.06 IM14144
  1.  ;S ACRDIR=$S($G(ACRDIR(1))]"":ACRDIR(1),1:ACRDEF)  ;ACR*2.1*13.06 IM14144;ACR*2.1*19.03 IM17636
  1.  S ACRDIR=ACRDEF                ;ACR*2.1*19.03 IM17636
  1.  ;S ACRFN="ACR"_$J              ;ACR*2.1*19.03 IM17636
  1.  S ACRFN="ACR"_$J_".Browser"    ;ACR*2.1*19.03 IM17636
  1.  S X=$$OPEN^%ZISH(ACRDIR,ACRFN,"W")
  1.  I IO="" S ACRQUIT="" Q
  1.  S IOST="P-DEC",IOST(0)=$O(^%ZIS(2,"B","P-DEC",0))
  1.  S IOSL=6000
  1.  S IOF="#"
  1.  U IO
  1.  D @ACRROU
  1.  ;D ^%ZISC                                     ;ACR*2.1*13.02 IM13574
  1.  D CLOSE^%ZISH("")                             ;ACR*2.1*13.02 IM13574
  1.  D HOME^%ZIS
  1.  D FILE(ACRDIR,ACRFN)
  1.  S X=$$DEL^%ZISH(ACRDIR,ACRFN)
  1.  K ACRDIR,ACRFN,ACRHDR,ACRNODE,ACRDIR,ACRFN
  1.  Q
  1.  ;
  1. VIEWD(ACRROU)         ;PEP ** USING ACRROU print to a host file for viewing
  1.  U IO(0)
  1.  ;S Y=$$PWD^%ZISH(.ACRDIR)                       ;ACR*2.1*19.03 IM17636
  1.  ;S ACRDIR=$S($G(ACRDIR(1))]"":ACRDIR(1),1:"/usr/spool/uucppublic/") ;ACR*2.1*13.06 IM14144
  1.  S ACRDEF=$$ARMSDIR^ACRFSYS(1)  ;ACR*2.1*13.06 IM14144
  1.  Q:ACRDEF']""                   ;ACR*2.1*13.06 IM14144
  1.  ;S ACRDIR=$S($G(ACRDIR(1))]"":ACRDIR(1),1:ACRDEF)  ;ACR*2.1*13.06 IM14144;ACR*2.1*19.03 IM17636
  1.  S ACRDIR=ACRDEF                ;ACR*2.1*19.03 IM17636
  1.  ;S ACRFN="ACR"_$J              ;ACR*2.1*19.03 IM17636
  1.  S ACRFN="ACR"_$J_".Browser"    ;ACR*2.1*19.03 IM17636
  1.  D DF^%ZISH(.ACRDIR)
  1.  S X=$$OPEN^%ZISH(ACRDIR,ACRFN,"W")
  1.  S IOP=IO_";P-DEC;"_IOM_";"_IOSL
  1.  ;D ^%ZISC                                     ;ACR*2.1*13.02 IM13574
  1.  D CLOSE^%ZISH("")                             ;ACR*2.1*13.02 IM13574
  1.  S IOST="P-DEC",IOST(0)=$O(^%ZIS(2,"B","P-DEC",0))
  1.  S IOSL=6000
  1.  S IOF="#"
  1.  S %ZIS("IOPAR")="("""_ACRDIR_ACRFN_""":""W"")"
  1.  D @ACRROU
  1.  D ^%ZISC
  1.  D HOME^%ZIS
  1.  D FILE^ACRFLM(ACRDIR,ACRFN)
  1.  S X=$$DEL^%ZISH(ACRDIR,ACRFN)
  1.  K ACRDIR,ACRFN,ACRNODE,ACRDIR,ACRFN
  1.  Q
  1.  ;
  1. ARRAY(ACRAR,ACRHDR)  ;PEP  Display an array that has (...,n,0) structure
  1.  I '$D(ACRHDR) S ACRHDR=""
  1.  N Y,X,I,ACRNODE
  1.  S ACRNODE=$G(XQORS)+1
  1.  K ^TMP("ACRLM",$J,ACRNODE)
  1.  S %X=ACRAR,%Y="^TMP(""ACRLM"","_$J_","_ACRNODE_","
  1.  D %XY^%RCR
  1.  D EN
  1.  K ^TMP("ACRLM",$J,+$G(ACRNODE))
  1.  K ACRNODE,ACRDIR,ACRFN
  1. ARRAYE ;
  1.  Q
  1.  ;
  1. STRIP(Z) ;REMOVE CONTROLL CHARACTERS
  1.  N I
  1.  F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)
  1.  Q Z