GMPLUTL4 ; SLC/KER/TC -- PL Utilities (Misc) ;03/07/17 08:48
;;2.0;Problem List;**26,49**;Aug 25, 1994;Build 43
;
; External References
; ICR 10066 XMZ^XMA2
; ICR 10070 ENT1^XMD
; DBIA 10096 ^%ZOSF("TEST")
;
; Variable Used but NEWed/KILLed Elsewhere
; IOT, ORWINDEV
;
;=================================================
ASKYN(GMPLDEF,GMPLTEXT) ;
N DIR,Y
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="Y0"
S DIR("A")=GMPLTEXT
S DIR("B")=GMPLDEF
S DIR("?")="Enter Y or N."
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) S Y=GMPLDEF
Q Y
;
;============================================
GETEHF(GMPLEXT,GMPLDPTH) ;Get an existing host file.
;Build a list of all .EXT files in the current directory.
N GMPLDEXT,DIR,DIROUT,DIRUT,DTOUT,DUOUT
N GMPLFSPC,GMPLFLST,GMPLPATH,X,Y,GMPLFILE
I GMPLEXT="" D
. S DIR(0)="FAU"_U_"1:32"
. S DIR("A")="Enter a file extension: "
. S DIR("?")="A file specification has the format name.extension."
. D ^DIR
. S GMPLEXT=Y
I $D(DIRUT) Q ""
S GMPLDEXT="*."_GMPLEXT
S GMPLFSPC(GMPLDEXT)=""
S GMPLPATH=$S($G(GMPLDPTH)'="":GMPLDPTH,1:$$PWD^%ZISH)
S DIR(0)="FAU"_U_"1:32"
S DIR("A")="Enter a path: "
S DIR("B")=GMPLPATH
S DIR("?",1)="A host file is a file on your host system."
S DIR("?",2)="A complete host file consists of a path, file name, and extension."
S DIR("?",3)="A path consists of a device and directory name."
I $G(GMPLEXT)'="" S DIR("?",4)="The default extension is "_GMPLEXT_"."
S DIR("?")="The default path is "_GMPLPATH
D ^DIR
I $D(DIRUT) Q ""
S GMPLPATH=Y
S Y=$$LIST^%ZISH(GMPLPATH,"GMPLFSPC","GMPLFLST")
I Y D
. W !,"The following "_GMPLEXT_" files were found in ",GMPLPATH
. S GMPLFILE=""
. F S GMPLFILE=$O(GMPLFLST(GMPLFILE)) Q:GMPLFILE="" W !,?2,GMPLFILE
E W !,"No "_GMPLEXT_" files were found in path ",GMPLPATH
;
K DIR,X,Y
S DIR(0)="FAOU"_U_"1:32"
S DIR("A")="Enter a file name: "
S DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is "_GMPLEXT
S DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"
S DIR("?")=" "_GMPLPATH_"FILE."_GMPLEXT
D ^DIR
I $D(DIRUT) Q ""
S GMPLFILE=Y
;Add the default extension if there isn't one.
I GMPLFILE'["." S GMPLFILE=GMPLFILE_"."_GMPLEXT
Q GMPLPATH_U_GMPLFILE
;
PTR(X) ; Output to Printer
; 1 = Yes
; 0 = No
Q:+($$VISTA)>0!(+($$HFP)>0) 1
Q 0
;
VISTA(X) ; Vista Printer
Q:$E($G(ION),1,3)="NUL" 0 Q:$G(IOT)'="HFS"&($E($G(IOST),1,2)["P-")&($G(IOST)'="P-OTHER") 1
Q 0
;
HFP(X) ; Host File sent to Printer
; Check ORWINDEV
N GMTS85 S GMTS85=$$PROK("ORWRP",85)
Q:+($G(GMTS85))>0&(+($G(ORWINDEV))>0) 1
; Check Host File Server
Q:$G(IOT)'="HFS" 0
; Host File for GUI Scrollable Window
Q:$E($G(ION),1,14)["OR WORKSTATION" 0
; TCP/IP Printer
Q:$G(IO)["$PRT"!($G(IO)["PRN|") 1
; Windows Printer
Q:$E($G(ION),1,14)["OR WINDOWS HFS" 1
; Host Files (file or unspecifed printer)
Q 0
;
; Miscellaneous
PROK(X,Y) ; Routine and Patch # OK
N GMTS,GMTSI,GMTSO S X=$G(X),Y=$G(Y) Q:'$L(X) 0 Q:Y'=""&(+Y=0)
S Y=+Y,GMTS=$$ROK(X) Q:'GMTS 0 Q:+Y=0 1 S GMTSO=0,GMTS=$T(@("+2^"_X)),GMTS=$P($P(GMTS,"**",2),"**",1)
F GMTSI=1:1:$L(GMTS,",") S:+($P(GMTS,",",GMTSI))=Y GMTSO=1 Q:GMTSO=1
S X=GMTSO Q X
ROK(X) ; Routine OK (in UCI)
S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
SEND(GMPLNODE,GMPLSUB,GMPLTO,GMPLFROM) ; Send a MailMan message whose text is in
;^TMP(GMPLNODE,$J,N,0). GMPLSUB is the subject. GMPLTO is the optional
;list of addresses, setup exactly like ;the MailMan XMY array.
;GMPLFROM is the optional message from, if it is not defined then from will be
;Problem List Support. This can be free text or a DUZ.
;
N GMPLNL,XMDUZ,XMSUB,XMY,XMZ
;
;Make sure the subject does not exceed 64 characters.
S XMSUB=$E(GMPLSUB,1,64)
;
;Make the default sender Problem List.
S XMDUZ=$S($G(GMPLFROM)="":"Problem List Support",1:GMPLFROM)
;
RETRY ;Get the message number.
D XMZ^XMA2
I XMZ<1 G RETRY
;
;Load the message
M ^XMB(3.9,XMZ,2)=^TMP(GMPLNODE,$J)
K ^TMP(GMPLNODE,$J)
S GMPLNL=$O(^XMB(3.9,XMZ,2,""),-1)
S ^XMB(3.9,XMZ,2,0)="^3.92^"_+GMPLNL_U_+GMPLNL_U_DT
;
;Send message to TO list if it is defined.
I $D(GMPLTO) M XMY=GMPLTO D ENT1^XMD Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLUTL4 4331 printed Sep 23, 2025@20:06:40 Page 2
GMPLUTL4 ; SLC/KER/TC -- PL Utilities (Misc) ;03/07/17 08:48
+1 ;;2.0;Problem List;**26,49**;Aug 25, 1994;Build 43
+2 ;
+3 ; External References
+4 ; ICR 10066 XMZ^XMA2
+5 ; ICR 10070 ENT1^XMD
+6 ; DBIA 10096 ^%ZOSF("TEST")
+7 ;
+8 ; Variable Used but NEWed/KILLed Elsewhere
+9 ; IOT, ORWINDEV
+10 ;
+11 ;=================================================
ASKYN(GMPLDEF,GMPLTEXT) ;
+1 NEW DIR,Y
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="Y0"
+4 SET DIR("A")=GMPLTEXT
+5 SET DIR("B")=GMPLDEF
+6 SET DIR("?")="Enter Y or N."
+7 WRITE !
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y=GMPLDEF
+10 QUIT Y
+11 ;
+12 ;============================================
GETEHF(GMPLEXT,GMPLDPTH) ;Get an existing host file.
+1 ;Build a list of all .EXT files in the current directory.
+2 NEW GMPLDEXT,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+3 NEW GMPLFSPC,GMPLFLST,GMPLPATH,X,Y,GMPLFILE
+4 IF GMPLEXT=""
Begin DoDot:1
+5 SET DIR(0)="FAU"_U_"1:32"
+6 SET DIR("A")="Enter a file extension: "
+7 SET DIR("?")="A file specification has the format name.extension."
+8 DO ^DIR
+9 SET GMPLEXT=Y
End DoDot:1
+10 IF $DATA(DIRUT)
QUIT ""
+11 SET GMPLDEXT="*."_GMPLEXT
+12 SET GMPLFSPC(GMPLDEXT)=""
+13 SET GMPLPATH=$SELECT($GET(GMPLDPTH)'="":GMPLDPTH,1:$$PWD^%ZISH)
+14 SET DIR(0)="FAU"_U_"1:32"
+15 SET DIR("A")="Enter a path: "
+16 SET DIR("B")=GMPLPATH
+17 SET DIR("?",1)="A host file is a file on your host system."
+18 SET DIR("?",2)="A complete host file consists of a path, file name, and extension."
+19 SET DIR("?",3)="A path consists of a device and directory name."
+20 IF $GET(GMPLEXT)'=""
SET DIR("?",4)="The default extension is "_GMPLEXT_"."
+21 SET DIR("?")="The default path is "_GMPLPATH
+22 DO ^DIR
+23 IF $DATA(DIRUT)
QUIT ""
+24 SET GMPLPATH=Y
+25 SET Y=$$LIST^%ZISH(GMPLPATH,"GMPLFSPC","GMPLFLST")
+26 IF Y
Begin DoDot:1
+27 WRITE !,"The following "_GMPLEXT_" files were found in ",GMPLPATH
+28 SET GMPLFILE=""
+29 FOR
SET GMPLFILE=$ORDER(GMPLFLST(GMPLFILE))
if GMPLFILE=""
QUIT
WRITE !,?2,GMPLFILE
End DoDot:1
+30 IF '$TEST
WRITE !,"No "_GMPLEXT_" files were found in path ",GMPLPATH
+31 ;
+32 KILL DIR,X,Y
+33 SET DIR(0)="FAOU"_U_"1:32"
+34 SET DIR("A")="Enter a file name: "
+35 SET DIR("?",1)="A file name has the format NAME.EXTENSION, the default extension is "_GMPLEXT
+36 SET DIR("?",2)="Therefore if you type in FILE for the file name, the host file will be"
+37 SET DIR("?")=" "_GMPLPATH_"FILE."_GMPLEXT
+38 DO ^DIR
+39 IF $DATA(DIRUT)
QUIT ""
+40 SET GMPLFILE=Y
+41 ;Add the default extension if there isn't one.
+42 IF GMPLFILE'["."
SET GMPLFILE=GMPLFILE_"."_GMPLEXT
+43 QUIT GMPLPATH_U_GMPLFILE
+44 ;
PTR(X) ; Output to Printer
+1 ; 1 = Yes
+2 ; 0 = No
+3 if +($$VISTA)>0!(+($$HFP)>0)
QUIT 1
+4 QUIT 0
+5 ;
VISTA(X) ; Vista Printer
+1 if $EXTRACT($GET(ION),1,3)="NUL"
QUIT 0
if $GET(IOT)'="HFS"&($EXTRACT($GET(IOST),1,2)["P-")&($GET(IOST)'="P-OTHER")
QUIT 1
+2 QUIT 0
+3 ;
HFP(X) ; Host File sent to Printer
+1 ; Check ORWINDEV
+2 NEW GMTS85
SET GMTS85=$$PROK("ORWRP",85)
+3 if +($GET(GMTS85))>0&(+($GET(ORWINDEV))>0)
QUIT 1
+4 ; Check Host File Server
+5 if $GET(IOT)'="HFS"
QUIT 0
+6 ; Host File for GUI Scrollable Window
+7 if $EXTRACT($GET(ION),1,14)["OR WORKSTATION"
QUIT 0
+8 ; TCP/IP Printer
+9 if $GET(IO)["$PRT"!($GET(IO)["PRN|")
QUIT 1
+10 ; Windows Printer
+11 if $EXTRACT($GET(ION),1,14)["OR WINDOWS HFS"
QUIT 1
+12 ; Host Files (file or unspecifed printer)
+13 QUIT 0
+14 ;
+15 ; Miscellaneous
PROK(X,Y) ; Routine and Patch # OK
+1 NEW GMTS,GMTSI,GMTSO
SET X=$GET(X)
SET Y=$GET(Y)
if '$LENGTH(X)
QUIT 0
if Y'=""&(+Y=0)
QUIT
+2 SET Y=+Y
SET GMTS=$$ROK(X)
if 'GMTS
QUIT 0
if +Y=0
QUIT 1
SET GMTSO=0
SET GMTS=$TEXT(@("+2^"_X))
SET GMTS=$PIECE($PIECE(GMTS,"**",2),"**",1)
+3 FOR GMTSI=1:1:$LENGTH(GMTS,",")
if +($PIECE(GMTS,",",GMTSI))=Y
SET GMTSO=1
if GMTSO=1
QUIT
+4 SET X=GMTSO
QUIT X
ROK(X) ; Routine OK (in UCI)
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT 0
if $LENGTH(X)>8
QUIT 0
XECUTE ^%ZOSF("TEST")
if $TEST
QUIT 1
QUIT 0
SEND(GMPLNODE,GMPLSUB,GMPLTO,GMPLFROM) ; Send a MailMan message whose text is in
+1 ;^TMP(GMPLNODE,$J,N,0). GMPLSUB is the subject. GMPLTO is the optional
+2 ;list of addresses, setup exactly like ;the MailMan XMY array.
+3 ;GMPLFROM is the optional message from, if it is not defined then from will be
+4 ;Problem List Support. This can be free text or a DUZ.
+5 ;
+6 NEW GMPLNL,XMDUZ,XMSUB,XMY,XMZ
+7 ;
+8 ;Make sure the subject does not exceed 64 characters.
+9 SET XMSUB=$EXTRACT(GMPLSUB,1,64)
+10 ;
+11 ;Make the default sender Problem List.
+12 SET XMDUZ=$SELECT($GET(GMPLFROM)="":"Problem List Support",1:GMPLFROM)
+13 ;
RETRY ;Get the message number.
+1 DO XMZ^XMA2
+2 IF XMZ<1
GOTO RETRY
+3 ;
+4 ;Load the message
+5 MERGE ^XMB(3.9,XMZ,2)=^TMP(GMPLNODE,$JOB)
+6 KILL ^TMP(GMPLNODE,$JOB)
+7 SET GMPLNL=$ORDER(^XMB(3.9,XMZ,2,""),-1)
+8 SET ^XMB(3.9,XMZ,2,0)="^3.92^"_+GMPLNL_U_+GMPLNL_U_DT
+9 ;
+10 ;Send message to TO list if it is defined.
+11 IF $DATA(GMPLTO)
MERGE XMY=GMPLTO
DO ENT1^XMD
QUIT
+12 ;
