Routine: PXRMINQ

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)

 ;====================================================

DISP(DIC,FLDS) ;Display detail.

N L

 S L=0

 D EN1^DIP

 ;====================================================

HEADER(TEXT) ;Display Header (see DHD variable).

 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,!!

 ;====================================================

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)

 ;====================================================

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)

 ;====================================================

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

 ;====================================================

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)

 ;====================================================

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="@@"

 ;====================================================

SPONSOR ;Do sponsor inquiry.

 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)

 ;====================================================

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)

 ;====================================================

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)

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

HEADER(TEXT) ;Display Header (see DHD variable).

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

SPONSOR   ;Do sponsor inquiry.

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

PXRMINQ.m