- 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 Feb 18, 2025@23:57 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 ;