- 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 ;