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