- PXRMXQUE ;SLC/PJH - Reminder reports general queuing routine. ;09/12/2012
- ;;2.0;CLINICAL REMINDERS;**4,6,12,17,24**;Feb 04, 2005;Build 193
- ;
- ;===============================
- DEVICE(RTN,DESC,SAVE,%ZIS,RETZTSK) ;
- ;Pass RETZTSK as number such as 1 if you want to get ZTSK.
- N ZTSK
- W !
- D EN^XUTMDEVQ(RTN,DESC,.SAVE,.%ZIS,RETZTSK)
- I $D(ZTSK) W !!,DESC," has been queued, task number "_ZTSK H 2
- Q $G(ZTSK)
- ;
- ;===============================
- JOB ;Get the output device.
- N POP,%ZIS
- S %ZIS="NQ"
- W !
- D ^%ZIS
- I POP G EXIT^PXRMXD
- I IOT="HFS" S PXRMHFIO=IO
- S PXRMQUE=$G(IO("Q"))
- S PXRMIOP=ION_";"_$G(IOST)_";"_$G(IO("DOC"))_";"_$G(IOM)_";"_$G(IOSL)
- ;
- I PXRMQUE D Q
- .;Queue the report.
- . N DESC,ROUTINE,TASK
- . S DESC="Reminder Due Report"
- . S ROUTINE="START^PXRMXSE1"
- . S TASK=$$QUE^PXRMXQUE(DESC,ROUTINE,"","SAVE^PXRMXQUE")
- . Q:TASK=""
- . W !,"Report queued, task number is ",TASK
- I 'PXRMQUE D ^PXRMXSE1
- Q
- ;
- ;===============================
- QUE(ZTDESC,ZTRTN,ZTDTH,SAVERTN) ;Queue a task.
- N ZTSK
- ;If ZTIO is not explicitly set to null then %ZTLOAD will open
- ;the device.
- S ZTIO=""
- D @SAVERTN
- D ^%ZTLOAD
- I $D(ZTSK)=0 W !!,DESC," cancelled." Q ""
- Q ZTSK
- ;
- ;===============================
- SAVE ;Save the variables for queing.
- S ZTSAVE("PXRMBDT")="",ZTSAVE("PXRMEDT")="",ZTSAVE("PXRMSDT")=""
- S ZTSAVE("PXRMCS(")="",ZTSAVE("NCS")=""
- S ZTSAVE("PXRMCGRP(")="",ZTSAVE("NCGRP")=""
- S ZTSAVE("PXRMFAC(")="",ZTSAVE("NFAC")=""
- S ZTSAVE("PXRMFACN(")=""
- S ZTSAVE("PXRMFCMB")=""
- S ZTSAVE("PXRMFUT")="",ZTSAVE("PXRMDLOC")=""
- S ZTSAVE("PXRMFD")=""
- S ZTSAVE("PXRMHFIO")=""
- S ZTSAVE("PXRMINP")=""
- S ZTSAVE("PXRMIO")=""
- S ZTSAVE("PXRMIOP")=""
- S ZTSAVE("PXRMLCHL(")="",ZTSAVE("NHL")=""
- S ZTSAVE("PXRMLCMB")=""
- S ZTSAVE("PXRMLCSC")=""
- S ZTSAVE("PXRMPRIM")=""
- S ZTSAVE("PXRMQUE")=""
- S ZTSAVE("PXRMREP")=""
- S ZTSAVE("PXRMRT")=""
- S ZTSAVE("PXRMSCAT")="",ZTSAVE("PXRMSCAT(")=""
- S ZTSAVE("PXRMSEL")=""
- S ZTSAVE("PXRMSRT")=""
- S ZTSAVE("PXRMSSN")=""
- S ZTSAVE("PXRMTABC")=""
- S ZTSAVE("PXRMTABS")=""
- S ZTSAVE("PXRMTCMB")=""
- S ZTSAVE("PXRMTMP")=""
- S ZTSAVE("PXRMTOT")=""
- S ZTSAVE("PXRMXTMP")=""
- ; Time initiated
- S ZTSAVE("PXRMXST")=""
- ; New selection criteria
- S ZTSAVE("PXRMOTM(")="",ZTSAVE("NOTM")=""
- S ZTSAVE("PXRMPRV(")="",ZTSAVE("NPRV")=""
- S ZTSAVE("PXRMPAT(")="",ZTSAVE("NPAT")=""
- S ZTSAVE("PXRMPCM(")="",ZTSAVE("NPCM")=""
- S ZTSAVE("PXRMREM(")="",ZTSAVE("NREM")=""
- S ZTSAVE("PXRMRCAT(")="",ZTSAVE("NCAT")=""
- S ZTSAVE("PXRMUSER")=""
- ;Reminder list
- S ZTSAVE("REMINDER(")=""
- ; Arrays by IEN
- S ZTSAVE("PXRMLOCN(")=""
- S ZTSAVE("PXRMCSN(")=""
- S ZTSAVE("PXRMCGRN(")=""
- ;Patient List
- S ZTSAVE("PATCREAT")=""
- S ZTSAVE("PATLST")=""
- S ZTSAVE("PXRMLIST(")=""
- S ZTSAVE("PXRMLIS1")=""
- S ZTSAVE("PLISTPUG")=""
- ;User DUZ
- S ZTSAVE("DBDUZ")=""
- S ZTSAVE("DBERR")=""
- S ZTSAVE("PXRMRERR(")=""
- ;Dubug information
- S ZTSAVE("PXRMDBUG")=""
- S ZTSAVE("PXRMDBUS")=""
- ;Patient Information
- S ZTSAVE("PXRMTPAT")=""
- S ZTSAVE("PXRMDPAT")=""
- I +$G(PXRMIDOD)>0 S ZTSAVE("PXRMIDOD")=""
- S ZTSAVE("PXRMPML")=""
- S ZTSAVE("PXRMPER")=""
- S ZTSAVE("PXRMCCS")=""
- S ZTSAVE("PXRMXCCS")=""
- I $D(^TMP("XM-MESS",$J)) S ZTSAVE("^TMP(""XM-MESS"",$J,")=""
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXQUE 3293 printed Feb 18, 2025@23:16:39 Page 2
- PXRMXQUE ;SLC/PJH - Reminder reports general queuing routine. ;09/12/2012
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12,17,24**;Feb 04, 2005;Build 193
- +2 ;
- +3 ;===============================
- DEVICE(RTN,DESC,SAVE,%ZIS,RETZTSK) ;
- +1 ;Pass RETZTSK as number such as 1 if you want to get ZTSK.
- +2 NEW ZTSK
- +3 WRITE !
- +4 DO EN^XUTMDEVQ(RTN,DESC,.SAVE,.%ZIS,RETZTSK)
- +5 IF $DATA(ZTSK)
- WRITE !!,DESC," has been queued, task number "_ZTSK
- HANG 2
- +6 QUIT $GET(ZTSK)
- +7 ;
- +8 ;===============================
- JOB ;Get the output device.
- +1 NEW POP,%ZIS
- +2 SET %ZIS="NQ"
- +3 WRITE !
- +4 DO ^%ZIS
- +5 IF POP
- GOTO EXIT^PXRMXD
- +6 IF IOT="HFS"
- SET PXRMHFIO=IO
- +7 SET PXRMQUE=$GET(IO("Q"))
- +8 SET PXRMIOP=ION_";"_$GET(IOST)_";"_$GET(IO("DOC"))_";"_$GET(IOM)_";"_$GET(IOSL)
- +9 ;
- +10 IF PXRMQUE
- Begin DoDot:1
- +11 ;Queue the report.
- +12 NEW DESC,ROUTINE,TASK
- +13 SET DESC="Reminder Due Report"
- +14 SET ROUTINE="START^PXRMXSE1"
- +15 SET TASK=$$QUE^PXRMXQUE(DESC,ROUTINE,"","SAVE^PXRMXQUE")
- +16 if TASK=""
- QUIT
- +17 WRITE !,"Report queued, task number is ",TASK
- End DoDot:1
- QUIT
- +18 IF 'PXRMQUE
- DO ^PXRMXSE1
- +19 QUIT
- +20 ;
- +21 ;===============================
- QUE(ZTDESC,ZTRTN,ZTDTH,SAVERTN) ;Queue a task.
- +1 NEW ZTSK
- +2 ;If ZTIO is not explicitly set to null then %ZTLOAD will open
- +3 ;the device.
- +4 SET ZTIO=""
- +5 DO @SAVERTN
- +6 DO ^%ZTLOAD
- +7 IF $DATA(ZTSK)=0
- WRITE !!,DESC," cancelled."
- QUIT ""
- +8 QUIT ZTSK
- +9 ;
- +10 ;===============================
- SAVE ;Save the variables for queing.
- +1 SET ZTSAVE("PXRMBDT")=""
- SET ZTSAVE("PXRMEDT")=""
- SET ZTSAVE("PXRMSDT")=""
- +2 SET ZTSAVE("PXRMCS(")=""
- SET ZTSAVE("NCS")=""
- +3 SET ZTSAVE("PXRMCGRP(")=""
- SET ZTSAVE("NCGRP")=""
- +4 SET ZTSAVE("PXRMFAC(")=""
- SET ZTSAVE("NFAC")=""
- +5 SET ZTSAVE("PXRMFACN(")=""
- +6 SET ZTSAVE("PXRMFCMB")=""
- +7 SET ZTSAVE("PXRMFUT")=""
- SET ZTSAVE("PXRMDLOC")=""
- +8 SET ZTSAVE("PXRMFD")=""
- +9 SET ZTSAVE("PXRMHFIO")=""
- +10 SET ZTSAVE("PXRMINP")=""
- +11 SET ZTSAVE("PXRMIO")=""
- +12 SET ZTSAVE("PXRMIOP")=""
- +13 SET ZTSAVE("PXRMLCHL(")=""
- SET ZTSAVE("NHL")=""
- +14 SET ZTSAVE("PXRMLCMB")=""
- +15 SET ZTSAVE("PXRMLCSC")=""
- +16 SET ZTSAVE("PXRMPRIM")=""
- +17 SET ZTSAVE("PXRMQUE")=""
- +18 SET ZTSAVE("PXRMREP")=""
- +19 SET ZTSAVE("PXRMRT")=""
- +20 SET ZTSAVE("PXRMSCAT")=""
- SET ZTSAVE("PXRMSCAT(")=""
- +21 SET ZTSAVE("PXRMSEL")=""
- +22 SET ZTSAVE("PXRMSRT")=""
- +23 SET ZTSAVE("PXRMSSN")=""
- +24 SET ZTSAVE("PXRMTABC")=""
- +25 SET ZTSAVE("PXRMTABS")=""
- +26 SET ZTSAVE("PXRMTCMB")=""
- +27 SET ZTSAVE("PXRMTMP")=""
- +28 SET ZTSAVE("PXRMTOT")=""
- +29 SET ZTSAVE("PXRMXTMP")=""
- +30 ; Time initiated
- +31 SET ZTSAVE("PXRMXST")=""
- +32 ; New selection criteria
- +33 SET ZTSAVE("PXRMOTM(")=""
- SET ZTSAVE("NOTM")=""
- +34 SET ZTSAVE("PXRMPRV(")=""
- SET ZTSAVE("NPRV")=""
- +35 SET ZTSAVE("PXRMPAT(")=""
- SET ZTSAVE("NPAT")=""
- +36 SET ZTSAVE("PXRMPCM(")=""
- SET ZTSAVE("NPCM")=""
- +37 SET ZTSAVE("PXRMREM(")=""
- SET ZTSAVE("NREM")=""
- +38 SET ZTSAVE("PXRMRCAT(")=""
- SET ZTSAVE("NCAT")=""
- +39 SET ZTSAVE("PXRMUSER")=""
- +40 ;Reminder list
- +41 SET ZTSAVE("REMINDER(")=""
- +42 ; Arrays by IEN
- +43 SET ZTSAVE("PXRMLOCN(")=""
- +44 SET ZTSAVE("PXRMCSN(")=""
- +45 SET ZTSAVE("PXRMCGRN(")=""
- +46 ;Patient List
- +47 SET ZTSAVE("PATCREAT")=""
- +48 SET ZTSAVE("PATLST")=""
- +49 SET ZTSAVE("PXRMLIST(")=""
- +50 SET ZTSAVE("PXRMLIS1")=""
- +51 SET ZTSAVE("PLISTPUG")=""
- +52 ;User DUZ
- +53 SET ZTSAVE("DBDUZ")=""
- +54 SET ZTSAVE("DBERR")=""
- +55 SET ZTSAVE("PXRMRERR(")=""
- +56 ;Dubug information
- +57 SET ZTSAVE("PXRMDBUG")=""
- +58 SET ZTSAVE("PXRMDBUS")=""
- +59 ;Patient Information
- +60 SET ZTSAVE("PXRMTPAT")=""
- +61 SET ZTSAVE("PXRMDPAT")=""
- +62 IF +$GET(PXRMIDOD)>0
- SET ZTSAVE("PXRMIDOD")=""
- +63 SET ZTSAVE("PXRMPML")=""
- +64 SET ZTSAVE("PXRMPER")=""
- +65 SET ZTSAVE("PXRMCCS")=""
- +66 SET ZTSAVE("PXRMXCCS")=""
- +67 IF $DATA(^TMP("XM-MESS",$JOB))
- SET ZTSAVE("^TMP(""XM-MESS"",$J,")=""
- +68 QUIT
- +69 ;