PXRMINQ ; SLC/PKR/PJH - Clinical Reminder inquiry routines. ;11/28/2008
;;2.0;CLINICAL REMINDERS;**4,12**;Feb 04, 2005;Build 73
;
;====================================================
CF ;Do computed finding inquiry.
N FLDS,HEADER,PXRMROOT,STEXT
S FLDS="[PXRM COMPUTED FINDING INQUIRY]"
S HEADER="REMINDER COMPUTED FINDING INQUIRY"
S PXRMROOT="^PXRMD(811.4,"
S STEXT="Select COMPUTED FINDING: "
D SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
Q
;
;====================================================
DISP(DIC,FLDS) ;Display detail.
N L
S L=0
D EN1^DIP
Q
;
;====================================================
N TEMP,TEXTLEN,TEXTUND
S TEXTUND=$TR($J("",IOM)," ","-")
S TEMP=NOW_" Page "_DC
S TEXTLEN=$L(TEMP)
W TEXT
W ?(IOM-TEXTLEN),TEMP
W !,TEXTUND,!!
Q
;
;====================================================
LOCLIST ;Do location list inquiry.
N FLDS,HEADER,PXRMEDOK,PXRMROOT,STEXT
S PXRMEDOK=1
S FLDS="[PXRM LOCATION LIST INQUIRY]"
S HEADER="REMINDER LOCATION LIST INQUIRY"
S PXRMROOT="^PXRMD(810.9,"
S STEXT="Select LOCATION LIST: "
D SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
Q
;
;====================================================
REM ;Do reminder inquiry.
N FLDS,HEADER,PXRMFVPL,PXRMROOT,STEXT
;Build the finding variable pointer information.
D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
S FLDS="[PXRM DEFINITION INQUIRY]"
S HEADER="REMINDER DEFINITION INQUIRY"
S PXRMROOT="^PXD(811.9,"
S STEXT="Select REMINDER DEFINITION: "
D SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
Q
;
;====================================================
REMVAR(VAR,IEN) ;Do reminder inquiry for reminder IEN, return formatted
;output in VAR. VAR can be either a local variable or a global.
;If it is a local it is indexed for the broker. If it is a global
;it should be passed in closed form i.e., ^TMP("PXRMTEST",$J).
;It will be returned formatted for ListMan i.e.,
;^TMP("PXRMTEST",$J,N,0).
N %ZIS,BY,DC,DHD,DONE,FF,FILENAME,FILESPEC,FLDS,FR,GBL,HFNAME
N IND,IOP,NOW,PATH,PXRMFVPL,PXRMROOT,SUCCESS,TO,UNIQN
;Build the finding variable pointer information.
D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
S FLDS="[PXRM DEFINITION INQUIRY]"
S PXRMROOT="^PXD(811.9,"
D SET(IEN,"")
;Make sure the PXRM WORKSTATION device exists.
D MKWSDEV^PXRMHOST
;Set up the output file before DIP is called.
S PATH=$$PWD^%ZISH
S NOW=$$NOW^XLFDT
S NOW=$TR(NOW,".","")
S UNIQN=$J_NOW
S FILENAME="PXRMWSD"_UNIQN_".DAT"
S HFNAME=PATH_FILENAME
S IOP="PXRM WORKSTATION;80"
S %ZIS("HFSMODE")="W"
S %ZIS("HFSNAME")=HFNAME
D DISP(PXRMROOT,FLDS)
;Move the host file into a global.
S GBL="^TMP(""PXRMINQ"",$J,1,0)"
S GBL=$NA(@GBL)
K ^TMP("PXRMINQ",$J)
S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)
;Look for a form feed, remove it and all subsequent lines.
S FF=$C(12)
I $G(VAR)["^" D
. S VAR=$NA(@VAR)
. S VAR=$P(VAR,")",1)
. S VAR=VAR_",IND,0)"
. S (DONE,IND)=0
. F Q:DONE S IND=$O(^TMP("PXRMINQ",$J,IND)) Q:+IND=0 D
.. I ^TMP("PXRMINQ",$J,IND,0)=FF S DONE=1 Q
.. S @VAR=^TMP("PXRMINQ",$J,IND,0)
E D
. S (DONE,IND)=0
. F Q:DONE S IND=$O(^TMP("PXRMINQ",$J,IND)) Q:+IND=0 D
.. S VAR(IND)=^TMP("PXRMINQ",$J,IND,0)
.. I VAR(IND)=FF S DONE=1
K ^TMP("PXRMINQ",$J)
;Delete the host file.
S FILESPEC(FILENAME)=""
S SUCCESS=$$DEL^%ZISH(PATH,$NA(FILESPEC))
Q
;
;====================================================
SELECT(ROOT,PROMPT,DEFAULT) ;Select the entry.
N DIC,DTOUT,DUOUT,Y
S DIC=ROOT
S DIC(0)="AEMQ"
S DIC("A")=PROMPT
I $G(DEFAULT)'="" S DIC("B")=DEFAULT
D ^DIC
Q Y
;
;====================================================
SELLOOP(PXRMROOT,FLDS,HEADER,STEXT) ;Selection loop.
N BY,DC,DHD,FR,IENN,NOW,TO
S IENN=0
F Q:IENN=-1 D
. S IENN=$$SELECT(PXRMROOT,STEXT,"")
. I IENN=-1 Q
. D SET(IENN,HEADER)
. D DISP(PXRMROOT,FLDS)
Q
;
;====================================================
SET(Y,TEXT) ;Set data for entry selection and the header.
;These variables need to be setup every time because DIP kills them.
;They are newed in the calling routine.
S BY="NUMBER"
S (FR,TO)=+$P(Y,U,1)
;If TEXT is null then no header.
I $L(TEXT)>0 D
. S NOW=$$NOW^XLFDT
. S NOW=$$FMTE^XLFDT(NOW,"1P")
. S DHD="W ?0 D HEADER^PXRMINQ("""_TEXT_""")"
E S DHD="@@"
Q
;
;====================================================
N FLDS,HEADER,PXRMEDOK,PXRMROOT,STEXT
S PXRMEDOK=1
S FLDS="[PXRM SPONSOR INQUIRY]"
S HEADER="REMINDER SPONSOR INQUIRY"
S PXRMROOT="^PXRMD(811.6,"
S STEXT="Select REMINDER SPONSOR: "
D SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
Q
;
;====================================================
TAX ;Do taxonomy inquiry.
N FLDS,HEADER,PXRMROOT,STEXT
S FLDS="[PXRM TAXONOMY INQUIRY]"
S HEADER="REMINDER TAXONOMY INQUIRY"
S PXRMROOT="^PXD(811.2,"
S STEXT="Select REMINDER TAXONOMY: "
D SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
Q
;
;====================================================
TERM ;Do term inquiry.
N FLDS,HEADER,PXRMFVPL,PXRMROOT,STEXT
;Build the finding variable pointer information
D BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
S FLDS="[PXRM TERM INQUIRY]"
S HEADER="REMINDER TERM INQUIRY"
S PXRMROOT="^PXRMD(811.5,"
S STEXT="Select REMINDER TERM: "
D SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMINQ 5426 printed Dec 13, 2024@01:46:14 Page 2
PXRMINQ ; SLC/PKR/PJH - Clinical Reminder inquiry routines. ;11/28/2008
+1 ;;2.0;CLINICAL REMINDERS;**4,12**;Feb 04, 2005;Build 73
+2 ;
+3 ;====================================================
CF ;Do computed finding inquiry.
+1 NEW FLDS,HEADER,PXRMROOT,STEXT
+2 SET FLDS="[PXRM COMPUTED FINDING INQUIRY]"
+3 SET HEADER="REMINDER COMPUTED FINDING INQUIRY"
+4 SET PXRMROOT="^PXRMD(811.4,"
+5 SET STEXT="Select COMPUTED FINDING: "
+6 DO SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
+7 QUIT
+8 ;
+9 ;====================================================
DISP(DIC,FLDS) ;Display detail.
+1 NEW L
+2 SET L=0
+3 DO EN1^DIP
+4 QUIT
+5 ;
+6 ;====================================================
+1 NEW TEMP,TEXTLEN,TEXTUND
+2 SET TEXTUND=$TRANSLATE($JUSTIFY("",IOM)," ","-")
+3 SET TEMP=NOW_" Page "_DC
+4 SET TEXTLEN=$LENGTH(TEMP)
+5 WRITE TEXT
+6 WRITE ?(IOM-TEXTLEN),TEMP
+7 WRITE !,TEXTUND,!!
+8 QUIT
+9 ;
+10 ;====================================================
LOCLIST ;Do location list inquiry.
+1 NEW FLDS,HEADER,PXRMEDOK,PXRMROOT,STEXT
+2 SET PXRMEDOK=1
+3 SET FLDS="[PXRM LOCATION LIST INQUIRY]"
+4 SET HEADER="REMINDER LOCATION LIST INQUIRY"
+5 SET PXRMROOT="^PXRMD(810.9,"
+6 SET STEXT="Select LOCATION LIST: "
+7 DO SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
+8 QUIT
+9 ;
+10 ;====================================================
REM ;Do reminder inquiry.
+1 NEW FLDS,HEADER,PXRMFVPL,PXRMROOT,STEXT
+2 ;Build the finding variable pointer information.
+3 DO BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
+4 SET FLDS="[PXRM DEFINITION INQUIRY]"
+5 SET HEADER="REMINDER DEFINITION INQUIRY"
+6 SET PXRMROOT="^PXD(811.9,"
+7 SET STEXT="Select REMINDER DEFINITION: "
+8 DO SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
+9 QUIT
+10 ;
+11 ;====================================================
REMVAR(VAR,IEN) ;Do reminder inquiry for reminder IEN, return formatted
+1 ;output in VAR. VAR can be either a local variable or a global.
+2 ;If it is a local it is indexed for the broker. If it is a global
+3 ;it should be passed in closed form i.e., ^TMP("PXRMTEST",$J).
+4 ;It will be returned formatted for ListMan i.e.,
+5 ;^TMP("PXRMTEST",$J,N,0).
+6 NEW %ZIS,BY,DC,DHD,DONE,FF,FILENAME,FILESPEC,FLDS,FR,GBL,HFNAME
+7 NEW IND,IOP,NOW,PATH,PXRMFVPL,PXRMROOT,SUCCESS,TO,UNIQN
+8 ;Build the finding variable pointer information.
+9 DO BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
+10 SET FLDS="[PXRM DEFINITION INQUIRY]"
+11 SET PXRMROOT="^PXD(811.9,"
+12 DO SET(IEN,"")
+13 ;Make sure the PXRM WORKSTATION device exists.
+14 DO MKWSDEV^PXRMHOST
+15 ;Set up the output file before DIP is called.
+16 SET PATH=$$PWD^%ZISH
+17 SET NOW=$$NOW^XLFDT
+18 SET NOW=$TRANSLATE(NOW,".","")
+19 SET UNIQN=$JOB_NOW
+20 SET FILENAME="PXRMWSD"_UNIQN_".DAT"
+21 SET HFNAME=PATH_FILENAME
+22 SET IOP="PXRM WORKSTATION;80"
+23 SET %ZIS("HFSMODE")="W"
+24 SET %ZIS("HFSNAME")=HFNAME
+25 DO DISP(PXRMROOT,FLDS)
+26 ;Move the host file into a global.
+27 SET GBL="^TMP(""PXRMINQ"",$J,1,0)"
+28 SET GBL=$NAME(@GBL)
+29 KILL ^TMP("PXRMINQ",$JOB)
+30 SET SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)
+31 ;Look for a form feed, remove it and all subsequent lines.
+32 SET FF=$CHAR(12)
+33 IF $GET(VAR)["^"
Begin DoDot:1
+34 SET VAR=$NAME(@VAR)
+35 SET VAR=$PIECE(VAR,")",1)
+36 SET VAR=VAR_",IND,0)"
+37 SET (DONE,IND)=0
+38 FOR
if DONE
QUIT
SET IND=$ORDER(^TMP("PXRMINQ",$JOB,IND))
if +IND=0
QUIT
Begin DoDot:2
+39 IF ^TMP("PXRMINQ",$JOB,IND,0)=FF
SET DONE=1
QUIT
+40 SET @VAR=^TMP("PXRMINQ",$JOB,IND,0)
End DoDot:2
End DoDot:1
+41 IF '$TEST
Begin DoDot:1
+42 SET (DONE,IND)=0
+43 FOR
if DONE
QUIT
SET IND=$ORDER(^TMP("PXRMINQ",$JOB,IND))
if +IND=0
QUIT
Begin DoDot:2
+44 SET VAR(IND)=^TMP("PXRMINQ",$JOB,IND,0)
+45 IF VAR(IND)=FF
SET DONE=1
End DoDot:2
End DoDot:1
+46 KILL ^TMP("PXRMINQ",$JOB)
+47 ;Delete the host file.
+48 SET FILESPEC(FILENAME)=""
+49 SET SUCCESS=$$DEL^%ZISH(PATH,$NAME(FILESPEC))
+50 QUIT
+51 ;
+52 ;====================================================
SELECT(ROOT,PROMPT,DEFAULT) ;Select the entry.
+1 NEW DIC,DTOUT,DUOUT,Y
+2 SET DIC=ROOT
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")=PROMPT
+5 IF $GET(DEFAULT)'=""
SET DIC("B")=DEFAULT
+6 DO ^DIC
+7 QUIT Y
+8 ;
+9 ;====================================================
SELLOOP(PXRMROOT,FLDS,HEADER,STEXT) ;Selection loop.
+1 NEW BY,DC,DHD,FR,IENN,NOW,TO
+2 SET IENN=0
+3 FOR
if IENN=-1
QUIT
Begin DoDot:1
+4 SET IENN=$$SELECT(PXRMROOT,STEXT,"")
+5 IF IENN=-1
QUIT
+6 DO SET(IENN,HEADER)
+7 DO DISP(PXRMROOT,FLDS)
End DoDot:1
+8 QUIT
+9 ;
+10 ;====================================================
SET(Y,TEXT) ;Set data for entry selection and the header.
+1 ;These variables need to be setup every time because DIP kills them.
+2 ;They are newed in the calling routine.
+3 SET BY="NUMBER"
+4 SET (FR,TO)=+$PIECE(Y,U,1)
+5 ;If TEXT is null then no header.
+6 IF $LENGTH(TEXT)>0
Begin DoDot:1
+7 SET NOW=$$NOW^XLFDT
+8 SET NOW=$$FMTE^XLFDT(NOW,"1P")
+9 SET DHD="W ?0 D HEADER^PXRMINQ("""_TEXT_""")"
End DoDot:1
+10 IF '$TEST
SET DHD="@@"
+11 QUIT
+12 ;
+13 ;====================================================
+1 NEW FLDS,HEADER,PXRMEDOK,PXRMROOT,STEXT
+2 SET PXRMEDOK=1
+3 SET FLDS="[PXRM SPONSOR INQUIRY]"
+4 SET HEADER="REMINDER SPONSOR INQUIRY"
+5 SET PXRMROOT="^PXRMD(811.6,"
+6 SET STEXT="Select REMINDER SPONSOR: "
+7 DO SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
+8 QUIT
+9 ;
+10 ;====================================================
TAX ;Do taxonomy inquiry.
+1 NEW FLDS,HEADER,PXRMROOT,STEXT
+2 SET FLDS="[PXRM TAXONOMY INQUIRY]"
+3 SET HEADER="REMINDER TAXONOMY INQUIRY"
+4 SET PXRMROOT="^PXD(811.2,"
+5 SET STEXT="Select REMINDER TAXONOMY: "
+6 DO SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
+7 QUIT
+8 ;
+9 ;====================================================
TERM ;Do term inquiry.
+1 NEW FLDS,HEADER,PXRMFVPL,PXRMROOT,STEXT
+2 ;Build the finding variable pointer information
+3 DO BLDRLIST^PXRMVPTR(811.52,.01,.PXRMFVPL)
+4 SET FLDS="[PXRM TERM INQUIRY]"
+5 SET HEADER="REMINDER TERM INQUIRY"
+6 SET PXRMROOT="^PXRMD(811.5,"
+7 SET STEXT="Select REMINDER TERM: "
+8 DO SELLOOP(PXRMROOT,FLDS,HEADER,STEXT)
+9 QUIT
+10 ;
