BDMFLM ; cmi/anch/maw - LIST MANAGER API'S ;
;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006
;; ;
DOC ;Documentation APIs for BDMLM Generic Display
;This utility uses the Veterans Administration List Manager (VALM)
;
; APIs
;
; FILE^BDMFLM("Directory","File Name") Displays file indicated
;
; SFILE^BDMFLM Selection of host file
; for display
;
; VIEWR^BDMFLM("TAG^ROUTINE","Header") Displays printout of the
; routine. (non - FM, using IO)
; VIEWD^BDMFLM("Tag^Routine","Header") Displays printout of the
; routine. (FM - using EN1^DIP)
; DIQ^BDMFLM("DIC","DA") Displays EN1^DIQ for the DIC,DA
; ARRAY^BDMFLM("array(","Header") Displays the array(..,n,0)
; (%RCR notation)
;
;
EN ; -- main entry point for BDM DISPLAY
D EN^VALM("BDM DISPLAY")
Q
;
HDR ;EP; -- header code
I BDMHDR]"" S VALMHDR(1)=BDMHDR
Q
;
INIT ;EP; -- init variables and list array
MARKERS I $G(BDMLMARK) F I=10:10 Q:'$D(@VALMAR@(I)) D
. F J=10:10:80 D CNTRL^VALM10(I,J,1,IORVON,IORVOFF)
K BDMLMARK
S VALMCNT=$O(^TMP("BDMVR",$J,+$G(BDMNODE),""),-1)
Q
;
HELP ;EP; -- help code
S X="?"
D DISP^XQORM1
W !!
Q
;
EXIT ;EP; -- exit code
K ^TMP("BDMVR",$J)
K ;
K BDMAR,BDMDIR,BDMFL,BDMFN,BDMHDR,BDMI,BDMROU,BDMDIR
I '$G(XQORS) D CLEAR^VALM1
Q
;
EXPND ; -- expand code
Q
;
FILE(BDMDIR,BDMFN) ;PEP pull up a file into the TMP global for display
I '$D(BDMHDR) S BDMHDR=""
N Y,X,I,BDMNODE
S BDMNODE=$G(XQORS)+1
S Y=$$OPEN^%ZISH(BDMDIR,BDMFN,"R")
I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",BDMDIR,BDMFN,"'." G EFILE
K ^TMP("BDMVR",$J,+$G(BDMNODE))
;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("BDMVR",$J,+$G(BDMNODE),I,0)=X Q:$$STATUS^%ZISH=-1
D ^%ZISC
S VALMCNT=$O(^TMP("BDMVR",$J,+$G(BDMNODE),""),-1)
D EN
K ^TMP("BDMVR",$J,+$G(BDMNODE))
EFILE ;
Q
;
VIEWR(BDMROU,BDMHDR) ;PEP USING BDMROU print to a host file for viewing
I '$D(BDMHDR) S BDMHDR=""
U IO(0)
S Y=$$PWD^%ZISH(.BDMDIR)
S BDMDIR=$S($G(BDMDIR(1))]"":BDMDIR(1),1:"C:\Inetpub\Ftproot\Pub\")
S BDMFN="BDM"_$J
S X=$$OPEN^%ZISH(BDMDIR,BDMFN,"W")
I IO="" S BDMQUIT="" Q
S IOST="P-DEC",IOST(0)=$O(^%ZIS(2,"B","P-DEC",0))
S IOSL=6000
S IOF="#"
U IO
D @BDMROU
D ^%ZISC
D HOME^%ZIS
D FILE(BDMDIR,BDMFN)
S X=$$DEL^%ZISH(BDMDIR,BDMFN)
K BDMDIR,BDMFN,BDMHDR,BDMNODE,BDMDIR,BDMFN
Q
;
VIEWD(BDMROU) ;PEP ** USING BDMROU print to a host file for viewing
U IO(0)
S Y=$$PWD^%ZISH(.BDMDIR)
S BDMDIR=$S($G(BDMDIR(1))]"":BDMDIR(1),1:"C:\Inetpub\Ftproot\Pub\")
S BDMFN="BDM"_$J
D DF^%ZISH(.BDMDIR)
S X=$$OPEN^%ZISH(BDMDIR,BDMFN,"W")
S IOP=IO_";P-DEC;"_IOM_";"_IOSL
D ^%ZISC
S IOST="P-DEC",IOST(0)=$O(^%ZIS(2,"B","P-DEC",0))
S IOSL=6000
S IOF="#"
S %ZIS("IOPAR")="("""_BDMDIR_BDMFN_""":""W"")"
D @BDMROU
D ^%ZISC
D HOME^%ZIS
D FILE^BDMFLM(BDMDIR,BDMFN)
S X=$$DEL^%ZISH(BDMDIR,BDMFN)
K BDMDIR,BDMFN,BDMNODE,BDMDIR,BDMFN
Q
;
ARRAY(BDMAR,BDMHDR) ;PEP Display an array that has (...,n,0) structure
I '$D(BDMHDR) S BDMHDR=""
N Y,X,I,BDMNODE
S BDMNODE=$G(XQORS)+1
K ^TMP("BDMVR",$J,BDMNODE)
S %X=BDMAR,%Y="^TMP(""BDMLM"","_$J_","_BDMNODE_","
D %XY^%RCR
D EN
K ^TMP("BDMVR",$J,+$G(BDMNODE))
K BDMNODE,BDMDIR,BDMFN
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
;
BDMFLM ; cmi/anch/maw - LIST MANAGER API'S ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006
+2 ;; ;
DOC ;Documentation APIs for BDMLM Generic Display
+1 ;This utility uses the Veterans Administration List Manager (VALM)
+2 ;
+3 ; APIs
+4 ;
+5 ; FILE^BDMFLM("Directory","File Name") Displays file indicated
+6 ;
+7 ; SFILE^BDMFLM Selection of host file
+8 ; for display
+9 ;
+10 ; VIEWR^BDMFLM("TAG^ROUTINE","Header") Displays printout of the
+11 ; routine. (non - FM, using IO)
+12 ; VIEWD^BDMFLM("Tag^Routine","Header") Displays printout of the
+13 ; routine. (FM - using EN1^DIP)
+14 ; DIQ^BDMFLM("DIC","DA") Displays EN1^DIQ for the DIC,DA
+15 ; ARRAY^BDMFLM("array(","Header") Displays the array(..,n,0)
+16 ; (%RCR notation)
+17 ;
+18 ;
EN ; -- main entry point for BDM DISPLAY
+1 DO EN^VALM("BDM DISPLAY")
+2 QUIT
+3 ;
HDR ;EP; -- header code
+1 IF BDMHDR]""
SET VALMHDR(1)=BDMHDR
+2 QUIT
+3 ;
INIT ;EP; -- init variables and list array
MARKERS IF $GET(BDMLMARK)
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 BDMLMARK
+3 SET VALMCNT=$ORDER(^TMP("BDMVR",$JOB,+$GET(BDMNODE),""),-1)
+4 QUIT
+5 ;
HELP ;EP; -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
+3 WRITE !!
+4 QUIT
+5 ;
EXIT ;EP; -- exit code
+1 KILL ^TMP("BDMVR",$JOB)
K ;
+1 KILL BDMAR,BDMDIR,BDMFL,BDMFN,BDMHDR,BDMI,BDMROU,BDMDIR
+2 IF '$GET(XQORS)
DO CLEAR^VALM1
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
FILE(BDMDIR,BDMFN) ;PEP pull up a file into the TMP global for display
+1 IF '$DATA(BDMHDR)
SET BDMHDR=""
+2 NEW Y,X,I,BDMNODE
+3 SET BDMNODE=$GET(XQORS)+1
+4 SET Y=$$OPEN^%ZISH(BDMDIR,BDMFN,"R")
+5 IF Y
WRITE !,*7,"CANNOT OPEN (OR ACCESS) FILE '",BDMDIR,BDMFN,"'."
GOTO EFILE
+6 KILL ^TMP("BDMVR",$JOB,+$GET(BDMNODE))
+7 ;THE READ STATEMENT BELOW IS A READ FROM A HOST FILE WHICH REQUIRES A
+8 ;DIRECT READ VS AN FM CALL
+9 FOR I=1:1
USE IO
READ X:DTIME
SET X=$$STRIP(X)
SET ^TMP("BDMVR",$JOB,+$GET(BDMNODE),I,0)=X
IF $$STATUS^%ZISH=-1
QUIT
+10 DO ^%ZISC
+11 SET VALMCNT=$ORDER(^TMP("BDMVR",$JOB,+$GET(BDMNODE),""),-1)
+12 DO EN
+13 KILL ^TMP("BDMVR",$JOB,+$GET(BDMNODE))
EFILE ;
+1 QUIT
+2 ;
VIEWR(BDMROU,BDMHDR) ;PEP USING BDMROU print to a host file for viewing
+1 IF '$DATA(BDMHDR)
SET BDMHDR=""
+2 USE IO(0)
+3 SET Y=$$PWD^%ZISH(.BDMDIR)
+4 SET BDMDIR=$SELECT($GET(BDMDIR(1))]"":BDMDIR(1),1:"C:\Inetpub\Ftproot\Pub\")
+5 SET BDMFN="BDM"_$JOB
+6 SET X=$$OPEN^%ZISH(BDMDIR,BDMFN,"W")
+7 IF IO=""
SET BDMQUIT=""
QUIT
+8 SET IOST="P-DEC"
SET IOST(0)=$ORDER(^%ZIS(2,"B","P-DEC",0))
+9 SET IOSL=6000
+10 SET IOF="#"
+11 USE IO
+12 DO @BDMROU
+13 DO ^%ZISC
+14 DO HOME^%ZIS
+15 DO FILE(BDMDIR,BDMFN)
+16 SET X=$$DEL^%ZISH(BDMDIR,BDMFN)
+17 KILL BDMDIR,BDMFN,BDMHDR,BDMNODE,BDMDIR,BDMFN
+18 QUIT
+19 ;
VIEWD(BDMROU) ;PEP ** USING BDMROU print to a host file for viewing
+1 USE IO(0)
+2 SET Y=$$PWD^%ZISH(.BDMDIR)
+3 SET BDMDIR=$SELECT($GET(BDMDIR(1))]"":BDMDIR(1),1:"C:\Inetpub\Ftproot\Pub\")
+4 SET BDMFN="BDM"_$JOB
+5 DO DF^%ZISH(.BDMDIR)
+6 SET X=$$OPEN^%ZISH(BDMDIR,BDMFN,"W")
+7 SET IOP=IO_";P-DEC;"_IOM_";"_IOSL
+8 DO ^%ZISC
+9 SET IOST="P-DEC"
SET IOST(0)=$ORDER(^%ZIS(2,"B","P-DEC",0))
+10 SET IOSL=6000
+11 SET IOF="#"
+12 SET %ZIS("IOPAR")="("""_BDMDIR_BDMFN_""":""W"")"
+13 DO @BDMROU
+14 DO ^%ZISC
+15 DO HOME^%ZIS
+16 DO FILE^BDMFLM(BDMDIR,BDMFN)
+17 SET X=$$DEL^%ZISH(BDMDIR,BDMFN)
+18 KILL BDMDIR,BDMFN,BDMNODE,BDMDIR,BDMFN
+19 QUIT
+20 ;
ARRAY(BDMAR,BDMHDR) ;PEP Display an array that has (...,n,0) structure
+1 IF '$DATA(BDMHDR)
SET BDMHDR=""
+2 NEW Y,X,I,BDMNODE
+3 SET BDMNODE=$GET(XQORS)+1
+4 KILL ^TMP("BDMVR",$JOB,BDMNODE)
+5 SET %X=BDMAR
SET %Y="^TMP(""BDMLM"","_$JOB_","_BDMNODE_","
+6 DO %XY^%RCR
+7 DO EN
+8 KILL ^TMP("BDMVR",$JOB,+$GET(BDMNODE))
+9 KILL BDMNODE,BDMDIR,BDMFN
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
+4 ;
