PXRMLPP.m

PXRMLPP ; SLC/PKR/PJH - Reminder Patient List Patients ;04/04/2007

 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123

 ;

 ;Main entry point for PXRM PATIENT LIST

START(IEN) ;

 N CDATE,CLASS,CREATOR,INDP,INTP,LDATA,LNAME,PXRMVIEW,SNAME,SOURCE,TYPE

 N VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD

 ;Get Patient List record and associated data.

 S LDATA=$G(^PXRMXP(810.5,IEN,0))

 S LNAME=$P(LDATA,U,1)

 S CDATE=$P(LDATA,U,4)

 S SOURCE=$P(LDATA,U,5),SNAME=""

 ;Check if generated from #810.2

 I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U)

 ;If not check if generated from #810.4

 I SNAME="" D

 . S SOURCE=$P(LDATA,U,6)

 . I SOURCE'="" S SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U)

 ;If still no source check for created from Reminder Due Report.

 I SNAME="" D

 . S SOURCE=$P(LDATA,U,9)

 . I SOURCE'="" S SNAME="Reminder Due Report"

 ;If there still is no source then assume it was generated in the

 ;past by a Reminder Due Report.

 I SNAME="" S SNAME="Reminder Due Report"

 ;Creator

 S CREATOR=+$P(LDATA,U,7)

 S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")

 ;Type

 S TYPE=$P(LDATA,U,8)

 S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)

 ;Class

 S CLASS=$P($G(^PXRMXP(810.5,IEN,100)),U)

 S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local")

 S INDP=$P(LDATA,U,11)

 S INTP=$P(LDATA,U,12)

 ;Default view by name.

 S PXRMVIEW="N"

 S VALMCNT=0

 D EN^VALM("PXRM PATIENT LIST PATIENTS")

 Q

 ;

BLDLIST(IEN) ;Build a list of all patients

 N IND,INCINST

 S INCINST=+$P(^PXRMXP(810.5,IEN,0),U,10)

 I 'INCINST D CHGCAP^VALM("HEADER3","")

 K ^TMP("PXRMLPP",$J),^TMP("PXRMLPPA",$J),^TMP("PXRMLPPI",$J)

 D LIST(.VALMCNT,.IEN,INCINST)

 F IND=1:1:VALMCNT D

 .S ^TMP("PXRMLPP",$J,"IDX",IND,IND)=^TMP("PXRMLPPI",$J,IND)

 K ^TMP("PXRMLPPI",$J)

 Q

DEM ;

 D FULL^VALM1

 D EN^PXRMPDR(IEN)

 S VALMBCK="R"

 Q

 ;

EDIT ;Edit selected patient list fields.

 N DA,DIE,DR,TEMP

 S DA=IEN,DIE="^PXRMXP(810.5,"

 S DR=".01;.08"

 I $D(^XUSEC("PXRM MANAGER",DUZ)) S DR=DR_";.07"

 D ^DIE

 S TEMP=^PXRMXP(810.5,IEN,0)

 S LNAME=$P(TEMP,U,1),CREATOR=$P(TEMP,U,7),TYPE=$P(TEMP,U,8)

 S CREATOR=$P(^VA(200,CREATOR,0),U,1)

 D HDR^PXRMLPP

 S VALMBCK="R"

 Q

 ;

EDITOK(IEN) ;Screen for protocol PXRM PATIENT LIST EDIT, return true if

 ;the user is permitted to edit the selected patient list.

 I $D(^XUSEC("PXRM MANAGER",DUZ)) Q 1

 N CREATOR

 S CREATOR=$P(^PXRMXP(810.5,IEN,0),U,7)

 Q $S(CREATOR=DUZ:1,1:0)

 ;

ENTRY ;Entry code

 D BLDLIST(IEN)

 D XQORM

 Q

 ;

EXIT ;Exit code

 K ^TMP("PXRMLPP",$J)

 K ^TMP("PXRMLPPH",$J)

 D CLEAN^VALM10

 D FULL^VALM1

 S VALMBCK="R"

 Q

 ;

FRE(NUMBER,PNAME,DFN,DECEASED,TESTP,INST) ;Format  entry number, name, primary

 ;station and deceased, test information.

 N TEMP,TEXT,TNAME,TSOURCE

 S TEXT=$$RJ^XLFSTR(NUMBER,5," ")

 S TEXT=$$SETFLD^VALM1(PNAME,TEXT,"HEADER1")

 S TEXT=TEXT_"  "_$$LJ^XLFSTR(DFN,15," ")

 S TEMP=""

 I DECEASED S TEMP=" (D)"

 I TESTP S TEMP=" (T)"

 I DECEASED,TESTP S TEMP=" (DP)"

 S TEXT=TEXT_TEMP

 I INST'="" S TEXT=$$SETFLD^VALM1(INST,TEXT,"HEADER3")

 Q TEXT

 ;

HDR ; Header code

 N TEXT

 S VALMHDR(1)="List Name: "_LNAME

 S VALMHDR(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")

 S VALMHDR(2)=$$LJ^XLFSTR(VALMHDR(2),40)_"Creator: "_CREATOR

 S VALMHDR(3)=" Class: "_CLASS

 S VALMHDR(3)=$$LJ^XLFSTR(VALMHDR(3),40)_"Type: "_TYPE

 S VALMHDR(4)=" Source: "_SNAME

 S VALMHDR(5)=" Number of patients: "_VALMCNT

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 S TEXT=""

 I INDP S TEXT=" (D=deceased)"

 I INTP S TEXT=" (T=test)"

 I INDP,INTP S TEXT=" (D=deceased, T=test)"

 S TEXT="DFN"_TEXT

 D CHGCAP^VALM("HEADER2",TEXT)

 Q

 ;

HLP ;Help code

 N ORU,ORUPRMT,SUB,XQORM

 S SUB="PXRMLPPH"

 D EN^VALM("PXRM PATIENT LIST HELP")

 Q

HSA ;Print Health Summary for all patients on list

 D HSA^PXRMLPHS(IEN)

 S VALMBCK="R"

 Q

 ;

HSI ;Print Health Summary for selected patients.

 ;Full Screen

 W IORESET

 N IND,DFN,PLNODE,PNAME,VALMY

 D EN^VALM2(XQORNOD(0))

 ;If there is no list quit.

 I '$D(VALMY) Q

 S PLNODE="PXRMLPHS"_$J_$$NOW^XLFDT

 K ^XTMP(PLNODE)

 S ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"

 S IND="",PXRMDONE=0

 F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D

 .;Get the patient list ien.

 .S DFN=^TMP("PXRMLPP",$J,"IDX",IND,IND)

 .;DBIA #10035

 .S PNAME=$P(^DPT(DFN,0),U,1)

 .I PNAME="" S PNAME=DFN_" does not exist"

 .S ^XTMP(PLNODE,PNAME)=DFN

 D HSI^PXRMLPHS(PLNODE)

 S VALMBCK="R"

 Q

 ;

INIT ;Init

 S VALMCNT=0

 Q

 ;

LIST(VALMCNT,IEN,INCINST) ;Build a list of patients.

 N DATA,DECEASED,DFN,IND,INST,NEXT,PNAME,SUB,TESTP

 ;Build the ordered list.

 S IND=0,SUB="NAME"

 F  S IND=$O(^PXRMXP(810.5,IEN,30,IND)) Q:'IND  D

 .S DATA=$G(^PXRMXP(810.5,IEN,30,IND,0)) Q:DATA=""

 .S DFN=$P(DATA,U) Q:'DFN

 .S DECEASED=$P(DATA,U,4)

 .S TESTP=$P(DATA,U,5)

 .;#DBIA 10035

 .S PNAME=$P($G(^DPT(DFN,0)),U,1)

 .I PNAME="" S PNAME=DFN_" does not exist"

 .S INSTNUM=$P(DATA,U,2) S:INSTNUM="" INSTNUM="NONE"

 .S INST=$P(DATA,U,3)

 .;Lists built before PXRM*2*4 will only have the Institution ien.

 .I INST="" S INST=$P(DATA,U,2)

 .I INST="" S INST="NONE"

 .I PXRMVIEW="I" S SUB=INST

 .S ^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)=DECEASED_U_TESTP_U_INST

 ;Transfer to list manager array 

 S SUB="",VALMCNT=0

 F  S SUB=$O(^TMP("PXRMLPPA",$J,SUB)) Q:SUB=""  D

 .S (INST,PNAME)=""

 .F  S PNAME=$O(^TMP("PXRMLPPA",$J,SUB,PNAME)) Q:PNAME=""  D

 ..S DFN=""

 ..F  S DFN=$O(^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)) Q:DFN=""  D

 ...S DATA=^TMP("PXRMLPPA",$J,SUB,PNAME,DFN)

 ...S DECEASED=$P(DATA,U,1)

 ...S TESTP=$P(DATA,U,2)

 ...I INCINST S INST=$P(DATA,U,3)

 ...S VALMCNT=VALMCNT+1

 ...S ^TMP("PXRMLPP",$J,VALMCNT,0)=$$FRE(VALMCNT,PNAME,DFN,DECEASED,TESTP,INST)

 ...S ^TMP("PXRMLPPI",$J,VALMCNT)=DFN

 K ^TMP("PXRMLPPA",$J)

 Q

 ;

PEXIT ;PXRM PATIENT LIST PATIENTS MENU protocol exit code

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 D XQORM

 Q

 ;

USER ;

 I $P($G(^PXRMXP(810.5,IEN,0)),U,8)="PUB" D FULL^VALM1 W !,"This option is locked for Public Lists." H 2 Q

 D FULL^VALM1

 D START^PXRMLPAU(IEN)

 S VALMBCK="R"

 Q

 ;

USR(IEN) ;Screen for protocol PXRM PATIENT LIST AUTH USER

 N TYPE

 S TYPE=$P(^PXRMXP(810.5,IEN,0),U,8)

 ;Public lists cannot have individual user access.

 I TYPE="PUB" Q "N"

 Q $$ACCESS^PXRMLPU(IEN)

 ;

VIEW ;Select view

 W IORESET

 S VALMBCK="R",VALMBG=1

 N X,Y,CODE,DIR

 K DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="S"_U_"I:Sort by Institution and Name;"

 S DIR(0)=DIR(0)_"N:Sort by Name;"

 S DIR("A")="TYPE OF VIEW"

 S DIR("B")=$S(PXRMVIEW="N":"I",1:"N")

 S DIR("?")="Select from the codes displayed."

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT)!($D(DUOUT)) Q

 ;Change display type

 S PXRMVIEW=Y

 ;Rebuild Workfile

 D BLDLIST^PXRMLPP(IEN),HDR

 Q

 ;

XSEL ;PXRM PATIENT LIST PATIENT SELECT validation

 N EPIEN,DFN,SEL

 S SEL=$P(XQORNOD(0),"=",2)

 ;Remove trailing ,

 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)

 ;Invalid selection

 I SEL["," D  Q

 .W $C(7),!,"Only one item number allowed." H 2

 .S VALMBCK="R"

 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D  Q

 .W $C(7),!,SEL_" is not a valid item number." H 2

 .S VALMBCK="R"

 ;

 ;Get the patient list ien

 S DFN=^TMP("PXRMLPP",$J,"IDX",SEL,SEL)

 ;Full screen mode

 D FULL^VALM1

 ;Print individual Health Summary

 D HSI^PXRMLPHS(DFN)

 S VALMBCK="R"

 Q

 ;

XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM PATIENT LIST PATIENT SELECT",0))_U_"1:"_VALMCNT

 S XQORM("A")="Select Item: "

 Q

 ;

PXRMLPP   ; SLC/PKR/PJH - Reminder Patient List Patients ;04/04/2007

 +1       ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123

 +2       ;

 +3       ;Main entry point for PXRM PATIENT LIST

START(IEN) ;

 +1        NEW CDATE,CLASS,CREATOR,INDP,INTP,LDATA,LNAME,PXRMVIEW,SNAME,SOURCE,TYPE

 +2        NEW VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD

 +3       ;Get Patient List record and associated data.

 +4        SET LDATA=$GET(^PXRMXP(810.5,IEN,0))

 +5        SET LNAME=$PIECE(LDATA,U,1)

 +6        SET CDATE=$PIECE(LDATA,U,4)

 +7        SET SOURCE=$PIECE(LDATA,U,5)

           SET SNAME=""

 +8       ;Check if generated from #810.2

 +9        IF SOURCE

               SET SNAME="Extract Parameter - "_$PIECE($GET(^PXRM(810.2,SOURCE,0)),U)

 +10      ;If not check if generated from #810.4

 +11       IF SNAME=""

               Begin DoDot:1

 +12               SET SOURCE=$PIECE(LDATA,U,6)

 +13               IF SOURCE'=""

                       SET SNAME="List Rule - "_$PIECE($GET(^PXRM(810.4,SOURCE,0)),U)

               End DoDot:1

 +14      ;If still no source check for created from Reminder Due Report.

 +15       IF SNAME=""

               Begin DoDot:1

 +16               SET SOURCE=$PIECE(LDATA,U,9)

 +17               IF SOURCE'=""

                       SET SNAME="Reminder Due Report"

               End DoDot:1

 +18      ;If there still is no source then assume it was generated in the

 +19      ;past by a Reminder Due Report.

 +20       IF SNAME=""

               SET SNAME="Reminder Due Report"

 +21      ;Creator

 +22       SET CREATOR=+$PIECE(LDATA,U,7)

 +23       SET CREATOR=$SELECT(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None")

 +24      ;Type

 +25       SET TYPE=$PIECE(LDATA,U,8)

 +26       SET TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM)

 +27      ;Class

 +28       SET CLASS=$PIECE($GET(^PXRMXP(810.5,IEN,100)),U)

 +29       SET CLASS=$SELECT(CLASS="N":"National",CLASS="V":"VISN",1:"Local")

 +30       SET INDP=$PIECE(LDATA,U,11)

 +31       SET INTP=$PIECE(LDATA,U,12)

 +32      ;Default view by name.

 +33       SET PXRMVIEW="N"

 +34       SET VALMCNT=0

 +35       DO EN^VALM("PXRM PATIENT LIST PATIENTS")

 +36       QUIT 

 +37      ;

BLDLIST(IEN) ;Build a list of all patients

 +1        NEW IND,INCINST

 +2        SET INCINST=+$PIECE(^PXRMXP(810.5,IEN,0),U,10)

 +3        IF 'INCINST

               DO CHGCAP^VALM("HEADER3","")

 +4        KILL ^TMP("PXRMLPP",$JOB),^TMP("PXRMLPPA",$JOB),^TMP("PXRMLPPI",$JOB)

 +5        DO LIST(.VALMCNT,.IEN,INCINST)

 +6        FOR IND=1:1:VALMCNT

               Begin DoDot:1

 +7                SET ^TMP("PXRMLPP",$JOB,"IDX",IND,IND)=^TMP("PXRMLPPI",$JOB,IND)

               End DoDot:1

 +8        KILL ^TMP("PXRMLPPI",$JOB)

 +9        QUIT 

DEM       ;

 +1        DO FULL^VALM1

 +2        DO EN^PXRMPDR(IEN)

 +3        SET VALMBCK="R"

 +4        QUIT 

 +5       ;

EDIT      ;Edit selected patient list fields.

 +1        NEW DA,DIE,DR,TEMP

 +2        SET DA=IEN

           SET DIE="^PXRMXP(810.5,"

 +3        SET DR=".01;.08"

 +4        IF $DATA(^XUSEC("PXRM MANAGER",DUZ))

               SET DR=DR_";.07"

 +5        DO ^DIE

 +6        SET TEMP=^PXRMXP(810.5,IEN,0)

 +7        SET LNAME=$PIECE(TEMP,U,1)

           SET CREATOR=$PIECE(TEMP,U,7)

           SET TYPE=$PIECE(TEMP,U,8)

 +8        SET CREATOR=$PIECE(^VA(200,CREATOR,0),U,1)

 +9        DO HDR^PXRMLPP

 +10       SET VALMBCK="R"

 +11       QUIT 

 +12      ;

EDITOK(IEN) ;Screen for protocol PXRM PATIENT LIST EDIT, return true if

 +1       ;the user is permitted to edit the selected patient list.

 +2        IF $DATA(^XUSEC("PXRM MANAGER",DUZ))

               QUIT 1

 +3        NEW CREATOR

 +4        SET CREATOR=$PIECE(^PXRMXP(810.5,IEN,0),U,7)

 +5        QUIT $SELECT(CREATOR=DUZ:1,1:0)

 +6       ;

ENTRY     ;Entry code

 +1        DO BLDLIST(IEN)

 +2        DO XQORM

 +3        QUIT 

 +4       ;

EXIT      ;Exit code

 +1        KILL ^TMP("PXRMLPP",$JOB)

 +2        KILL ^TMP("PXRMLPPH",$JOB)

 +3        DO CLEAN^VALM10

 +4        DO FULL^VALM1

 +5        SET VALMBCK="R"

 +6        QUIT 

 +7       ;

FRE(NUMBER,PNAME,DFN,DECEASED,TESTP,INST) ;Format  entry number, name, primary

 +1       ;station and deceased, test information.

 +2        NEW TEMP,TEXT,TNAME,TSOURCE

 +3        SET TEXT=$$RJ^XLFSTR(NUMBER,5," ")

 +4        SET TEXT=$$SETFLD^VALM1(PNAME,TEXT,"HEADER1")

 +5        SET TEXT=TEXT_"  "_$$LJ^XLFSTR(DFN,15," ")

 +6        SET TEMP=""

 +7        IF DECEASED

               SET TEMP=" (D)"

 +8        IF TESTP

               SET TEMP=" (T)"

 +9        IF DECEASED

               IF TESTP

                   SET TEMP=" (DP)"

 +10       SET TEXT=TEXT_TEMP

 +11       IF INST'=""

               SET TEXT=$$SETFLD^VALM1(INST,TEXT,"HEADER3")

 +12       QUIT TEXT

 +13      ;

HDR       ; Header code

 +1        NEW TEXT

 +2        SET VALMHDR(1)="List Name: "_LNAME

 +3        SET VALMHDR(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z")

 +4        SET VALMHDR(2)=$$LJ^XLFSTR(VALMHDR(2),40)_"Creator: "_CREATOR

 +5        SET VALMHDR(3)=" Class: "_CLASS

 +6        SET VALMHDR(3)=$$LJ^XLFSTR(VALMHDR(3),40)_"Type: "_TYPE

 +7        SET VALMHDR(4)=" Source: "_SNAME

 +8        SET VALMHDR(5)=" Number of patients: "_VALMCNT

 +9        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +10       SET TEXT=""

 +11       IF INDP

               SET TEXT=" (D=deceased)"

 +12       IF INTP

               SET TEXT=" (T=test)"

 +13       IF INDP

               IF INTP

                   SET TEXT=" (D=deceased, T=test)"

 +14       SET TEXT="DFN"_TEXT

 +15       DO CHGCAP^VALM("HEADER2",TEXT)

 +16       QUIT 

 +17      ;

HLP       ;Help code

 +1        NEW ORU,ORUPRMT,SUB,XQORM

 +2        SET SUB="PXRMLPPH"

 +3        DO EN^VALM("PXRM PATIENT LIST HELP")

 +4        QUIT 

HSA       ;Print Health Summary for all patients on list

 +1        DO HSA^PXRMLPHS(IEN)

 +2        SET VALMBCK="R"

 +3        QUIT 

 +4       ;

HSI       ;Print Health Summary for selected patients.

 +1       ;Full Screen

 +2        WRITE IORESET

 +3        NEW IND,DFN,PLNODE,PNAME,VALMY

 +4        DO EN^VALM2(XQORNOD(0))

 +5       ;If there is no list quit.

 +6        IF '$DATA(VALMY)

               QUIT 

 +7        SET PLNODE="PXRMLPHS"_$JOB_$$NOW^XLFDT

 +8        KILL ^XTMP(PLNODE)

 +9        SET ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"

 +10       SET IND=""

           SET PXRMDONE=0

 +11       FOR 

               SET IND=$ORDER(VALMY(IND))

               IF (+IND=0)!(PXRMDONE)

                   QUIT 

               Begin DoDot:1

 +12      ;Get the patient list ien.

 +13               SET DFN=^TMP("PXRMLPP",$JOB,"IDX",IND,IND)

 +14      ;DBIA #10035

 +15               SET PNAME=$PIECE(^DPT(DFN,0),U,1)

 +16               IF PNAME=""

                       SET PNAME=DFN_" does not exist"

 +17               SET ^XTMP(PLNODE,PNAME)=DFN

               End DoDot:1

 +18       DO HSI^PXRMLPHS(PLNODE)

 +19       SET VALMBCK="R"

 +20       QUIT 

 +21      ;

INIT      ;Init

 +1        SET VALMCNT=0

 +2        QUIT 

 +3       ;

LIST(VALMCNT,IEN,INCINST) ;Build a list of patients.

 +1        NEW DATA,DECEASED,DFN,IND,INST,NEXT,PNAME,SUB,TESTP

 +2       ;Build the ordered list.

 +3        SET IND=0

           SET SUB="NAME"

 +4        FOR 

               SET IND=$ORDER(^PXRMXP(810.5,IEN,30,IND))

               IF 'IND

                   QUIT 

               Begin DoDot:1

 +5                SET DATA=$GET(^PXRMXP(810.5,IEN,30,IND,0))

                   IF DATA=""

                       QUIT 

 +6                SET DFN=$PIECE(DATA,U)

                   IF 'DFN

                       QUIT 

 +7                SET DECEASED=$PIECE(DATA,U,4)

 +8                SET TESTP=$PIECE(DATA,U,5)

 +9       ;#DBIA 10035

 +10               SET PNAME=$PIECE($GET(^DPT(DFN,0)),U,1)

 +11               IF PNAME=""

                       SET PNAME=DFN_" does not exist"

 +12               SET INSTNUM=$PIECE(DATA,U,2)

                   IF INSTNUM=""

                       SET INSTNUM="NONE"

 +13               SET INST=$PIECE(DATA,U,3)

 +14      ;Lists built before PXRM*2*4 will only have the Institution ien.

 +15               IF INST=""

                       SET INST=$PIECE(DATA,U,2)

 +16               IF INST=""

                       SET INST="NONE"

 +17               IF PXRMVIEW="I"

                       SET SUB=INST

 +18               SET ^TMP("PXRMLPPA",$JOB,SUB,PNAME,DFN)=DECEASED_U_TESTP_U_INST

               End DoDot:1

 +19      ;Transfer to list manager array 

 +20       SET SUB=""

           SET VALMCNT=0

 +21       FOR 

               SET SUB=$ORDER(^TMP("PXRMLPPA",$JOB,SUB))

               IF SUB=""

                   QUIT 

               Begin DoDot:1

 +22               SET (INST,PNAME)=""

 +23               FOR 

                       SET PNAME=$ORDER(^TMP("PXRMLPPA",$JOB,SUB,PNAME))

                       IF PNAME=""

                           QUIT 

                       Begin DoDot:2

 +24                       SET DFN=""

 +25                       FOR 

                               SET DFN=$ORDER(^TMP("PXRMLPPA",$JOB,SUB,PNAME,DFN))

                               IF DFN=""

                                   QUIT 

                               Begin DoDot:3

 +26                               SET DATA=^TMP("PXRMLPPA",$JOB,SUB,PNAME,DFN)

 +27                               SET DECEASED=$PIECE(DATA,U,1)

 +28                               SET TESTP=$PIECE(DATA,U,2)

 +29                               IF INCINST

                                       SET INST=$PIECE(DATA,U,3)

 +30                               SET VALMCNT=VALMCNT+1

 +31                               SET ^TMP("PXRMLPP",$JOB,VALMCNT,0)=$$FRE(VALMCNT,PNAME,DFN,DECEASED,TESTP,INST)

 +32                               SET ^TMP("PXRMLPPI",$JOB,VALMCNT)=DFN

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +33       KILL ^TMP("PXRMLPPA",$JOB)

 +34       QUIT 

 +35      ;

PEXIT     ;PXRM PATIENT LIST PATIENTS MENU protocol exit code

 +1        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +2        DO XQORM

 +3        QUIT 

 +4       ;

USER      ;

 +1        IF $PIECE($GET(^PXRMXP(810.5,IEN,0)),U,8)="PUB"

               DO FULL^VALM1

               WRITE !,"This option is locked for Public Lists."

               HANG 2

               QUIT 

 +2        DO FULL^VALM1

 +3        DO START^PXRMLPAU(IEN)

 +4        SET VALMBCK="R"

 +5        QUIT 

 +6       ;

USR(IEN)  ;Screen for protocol PXRM PATIENT LIST AUTH USER

 +1        NEW TYPE

 +2        SET TYPE=$PIECE(^PXRMXP(810.5,IEN,0),U,8)

 +3       ;Public lists cannot have individual user access.

 +4        IF TYPE="PUB"

               QUIT "N"

 +5        QUIT $$ACCESS^PXRMLPU(IEN)

 +6       ;

VIEW      ;Select view

 +1        WRITE IORESET

 +2        SET VALMBCK="R"

           SET VALMBG=1

 +3        NEW X,Y,CODE,DIR

 +4        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +5        SET DIR(0)="S"_U_"I:Sort by Institution and Name;"

 +6        SET DIR(0)=DIR(0)_"N:Sort by Name;"

 +7        SET DIR("A")="TYPE OF VIEW"

 +8        SET DIR("B")=$SELECT(PXRMVIEW="N":"I",1:"N")

 +9        SET DIR("?")="Select from the codes displayed."

 +10       DO ^DIR

           KILL DIR

 +11       IF $DATA(DIROUT)

               SET DTOUT=1

 +12       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +13      ;Change display type

 +14       SET PXRMVIEW=Y

 +15      ;Rebuild Workfile

 +16       DO BLDLIST^PXRMLPP(IEN)

           DO HDR

 +17       QUIT 

 +18      ;

XSEL      ;PXRM PATIENT LIST PATIENT SELECT validation

 +1        NEW EPIEN,DFN,SEL

 +2        SET SEL=$PIECE(XQORNOD(0),"=",2)

 +3       ;Remove trailing ,

 +4        IF $EXTRACT(SEL,$LENGTH(SEL))=","

               SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)

 +5       ;Invalid selection

 +6        IF SEL[","

               Begin DoDot:1

 +7                WRITE $CHAR(7),!,"Only one item number allowed."

                   HANG 2

 +8                SET VALMBCK="R"

               End DoDot:1

               QUIT 

 +9        IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("IDX",SEL)))

               Begin DoDot:1

 +10               WRITE $CHAR(7),!,SEL_" is not a valid item number."

                   HANG 2

 +11               SET VALMBCK="R"

               End DoDot:1

               QUIT 

 +12      ;

 +13      ;Get the patient list ien

 +14       SET DFN=^TMP("PXRMLPP",$JOB,"IDX",SEL,SEL)

 +15      ;Full screen mode

 +16       DO FULL^VALM1

 +17      ;Print individual Health Summary

 +18       DO HSI^PXRMLPHS(DFN)

 +19       SET VALMBCK="R"

 +20       QUIT 

 +21      ;

XQORM      SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM PATIENT LIST PATIENT SELECT",0))_U_"1:"_VALMCNT

 +1        SET XQORM("A")="Select Item: "

 +2        QUIT 

 +3       ;