PSOPMP0.m

PSOPMP0 ;BIRM/MFR - Patient Medication Profile - Listmanager ;10/28/06

 ;;7.0;OUTPATIENT PHARMACY;**260,281,303,289**;DEC 1997;Build 107

 ;Reference to EN1^GMRADPT supported by IA #10099

 ;Reference to EN6^GMRVUTL supported by IA #1120

 ;Reference to ^PS(55 supported by DBIA 2228

 ;

EN ;Menu option entry point

 N PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSIGDP,PSOSTSGP,PSOSTORD,PSORDCNT,PSOSTSEQ,PSORDSEQ,PSOCHNG

 N GRPLN,DIC,Y,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT

 ;

 ;Division selection

 I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT

 ;

 ;Patient selection

 W !! S DIC=2,DIC(0)="QEAM" D ^DIC G EXIT:Y<0  S DFN=+Y

 S PSODFN=DFN D CHKADDR^PSOBAI(DFN,1,1)  ;bad address flag/update

 D LST(PSOSITE,DFN)

 Q

 ;

LST(SITE,PSODFN) ;ListManager entry point

 ; Loading Division/User preferences

 D LOAD^PSOPMPPF(SITE,DUZ)

 W !,"Please wait..."

 D EN^VALM("PSO PMP MAIN")

 D FULL^VALM1

 G EXIT

 ;

HDR      ;Header

 N LINE,POS,LINE1,LINE2,LINE3,LINE4,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,GMRAL,ADVREA

 K VADM S DFN=PSODFN D DEM^VADPT

 S PNAME=VADM(1)

 S DOB=$S(+VADM(3):$P(VADM(3),"^",2)_" ("_$G(VADM(4))_")",1:"UNKNOWN")

 S SEX=$P(VADM(5),"^",2)

 S (WT,X)="",GMRVSTR="WT" D EN6^GMRVUTL I X'="" S WT=$J($P(X,"^",8)/2.2,6,2),WTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1)

 S (HT,X)="",GMRVSTR="HT" D EN6^GMRVUTL I X'="" S HT=$J($P(X,"^",8)*2.54,6,2),HTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1)

 S LINE1=PNAME

 S LINE1=$$ALLERGY^PSOPMP1(LINE1,DFN)

 S LINE2="  PID: "_$P(VADM(2),"^",2),$E(LINE2,50)="HEIGHT(cm): "_$S(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE")

 S LINE3="  DOB: "_DOB,$E(LINE3,50)="WEIGHT(kg): "_$S(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE")

 S LINE4="  SEX: "_SEX,$E(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS"

 ;

 K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2,VALMHDR(3)=LINE3,VALMHDR(4)=LINE4

 D SETHDR^PSOPMP1()

 Q

 ;

INIT ;Populates the Body section for ListMan

 K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J)

 D SETSORT(PSOSRTBY),SETLINE

 S VALMSG="Select the entry # to view or ?? for more actions"

 Q

 ;

SETLINE ;Sets the line to be displayed in ListMan

 N TYPE,STS,SUB,SEQ,LINE,Z,TOTAL,I,X,X1,ORDCNT,LBL,LN,IENSUB,GROUP,GRP,QTYL

 I '$D(^TMP("PSOPMPSR",$J)) D  Q

 . F I=1:1:6 S ^TMP("PSOPMP0",$J,I,0)=""

 . S ^TMP("PSOPMP0",$J,7,0)="                    No prescriptions found for this patient."

 . S VALMCNT=1

 ;

 ;Resetting list to NORMAL video attributes

 F I=1:1:$G(LASTLINE) D RESTORE^VALM10(I)

 K GRPLN,HIGHLN

 ;Building the list (line by line)

 S (GROUP,STS,SUB)="",LINE=0 K ^TMP("PSOPMP0",$J)

 F  S GROUP=$O(^TMP("PSOPMPSR",$J,GROUP)) Q:GROUP=""  D

 . S GRP=$P(GROUP,"^")

 . I GRP'["R"!('PSOSTSGP&($O(^TMP("PSOPMPSR",$J,GROUP),-1)'="")) D

 . . D GROUP^PSOPMP1($P(GROUP,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP)),.LINE)

 . F  S STS=$O(^TMP("PSOPMPSR",$J,GROUP,STS)) Q:STS=""  D

 . . I STS'="<NULL>" D

 . . . D GROUP^PSOPMP1($P(STS,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP,STS)),.LINE)

 . . F  S SUB=$O(^TMP("PSOPMPSR",$J,GROUP,STS,SUB),$S(PSORDER="A":1,1:-1)) Q:SUB=""  D

 . . . S Z=$G(^TMP("PSOPMPSR",$J,GROUP,STS,SUB))

 . . . S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3)

 . . . S QTYL=$L($P(Z,"^",4)) S:QTYL<5 QTYL=5

 . . . I GRP["R"!(GRP["T") S $E(X1,5)=$P(Z,"^",2),$E(X1,19)=$E($P(Z,"^",3),1,(32-QTYL))

 . . . I GRP["P"!(GRP["N") S $E(X1,5)=$P(Z,"^",3)

 . . . I GRP["N" S $E(X1,49)="Date Documented:"

 . . . I GRP'["N" S $E(X1,52-QTYL)=$J($P(Z,"^",4),QTYL),$E(X1,53)=$P(Z,"^",5),$E(X1,57)=$P(Z,"^",6)

 . . . S $E(X1,66)=$P(Z,"^",7)

 . . . S $E(X1,74)=$J($P(Z,"^",8),3),$E(X1,78)=$J($P(Z,"^",9),3)

 . . . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X1,HIGHLN(LINE)=""

 . . . S IENSUB=$S(GRP["R"!(GRP["T"):"RX",GRP["P":"PEN",1:"NVA")

 . . . S ^TMP("PSOPMP0",$J,SEQ,IENSUB)=$P(Z,"^")

 . . . I IENSUB="PEN"&($P($G(^PS(52.41,+$P(Z,"^"),0)),"^",23)=1) S ^TMP("PSOPMP0",$J,LINE,"RV")=1

 . . . I $G(PSOSIGDP) D SETSIG^PSOPMP1($S(GRP["R"!(GRP["T"):"R",GRP["P":"P",1:"N"),+Z,.LINE,PSODFN)

 ;

 ;Saving NORMAL video attributes to be reset later

 I LINE>$G(LASTLINE) D

 . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)

 . S LASTLINE=LINE

 D VIDEO^PSOPMP1()

 S VALMCNT=+$G(LINE) D RV^PSOPMP1

 Q

 ;

SETSORT(FIELD) ;Sets the data sorted by the FIELD specified

 N SEQ,RX,RXNUM,DRUG,DRNAME,QTY,STATUS,STS,ISSDT,DOCDAT,LSTFD,REFREM,DAYSUP,SIG,Z,ORD,GRPCNT,GROUP,RFRX,OI,PSOBADR

 K ^TMP("PSOPMPSR",$J)

 ;Loading prescription (file #55)

 S SEQ=0

 F  S SEQ=$O(^PS(55,PSODFN,"P",SEQ)) Q:'SEQ  D

 . S RX=+$G(^PS(55,PSODFN,"P",SEQ,0)) I 'RX!($G(^PSRX(RX,0))="") Q

 . I $$FILTER^PSOPMP1(RX) Q

 . S RXNUM=$$GET1^DIQ(52,RX,.01)

 . S DRUG=$$GET1^DIQ(52,RX,6,"I")

 . S DRNAME=$$GET1^DIQ(50,DRUG,.01)

 . S QTY=$$GET1^DIQ(52,RX,7)

 . S STATUS=$$STSINFO^PSOPMP1(RX)

 . S ISSDT=$$ISSDT^PSOPMP1(RX,"R")

 . S LSTFD=$$LSTFD^PSOPMP1(RX)

 . S REFREM=$$REFREM^PSOPMP1(RX)

 . S DAYSUP=$$GET1^DIQ(52,RX,8)

 . S PSOBADR=$O(^PSRX(RX,"L",9999),-1)

 . I PSOBADR'="" S PSOBADR=$G(^PSRX(RX,"L",PSOBADR,0)) I PSOBADR["(BAD ADDRESS)" S PSOBADR="B"

 . I PSOBADR'="B" S PSOBADR=""

 . S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=RXNUM_$$COPAY^PSOPMP1(RX)_$$ECME^PSOBPSUT(RX),$P(Z,"^",3)=$E(DRNAME,1,30)

 . S $P(Z,"^",4)=QTY,$P(Z,"^",5)=$P(STATUS,"^",3)_$$CMOP^PSOPMP1(DRUG,RX)_PSOBADR,$P(Z,"^",6)=$P(ISSDT,"^",2)

 . S $P(Z,"^",7)=$P(LSTFD,"^",2),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP

 . S SORT=$S(FIELD="RX":RXNUM_" ",FIELD="DR":DRNAME_RXNUM,FIELD="ID":+ISSDT_RXNUM_" ",FIELD="LF":+LSTFD_RXNUM_" ")

 . S STS="<NULL>" I $G(PSOSTSGP) S STS=$P(STATUS,"^")_"^"_$P(STATUS,"^",2)

 . S GROUP=$P(PSORDSEQ("R"),"^")_"R^"_$P(PSORDSEQ("R"),"^",2)

 . I $$FIND^PSOREJUT(RX,,,"79,88") S GROUP=$P(PSORDSEQ("T"),"^")_"T^"_$P(PSORDSEQ("T"),"^",2),STS="<NULL>"

 . S ^TMP("PSOPMPSR",$J,GROUP,STS,SORT)=Z

 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1,GRPCNT(GROUP,STS)=$G(GRPCNT(GROUP,STS))+1

 ;

 S GROUP=""

 F  S GROUP=$O(GRPCNT(GROUP)) Q:GROUP=""  D

 . S ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))

 . S STS="" F  S STS=$O(GRPCNT(GROUP,STS)) Q:STS=""  D

 . . S ^TMP("PSOPMPSR",$J,GROUP,STS)=GRPCNT(GROUP,STS)

 ;

 ;Loading pending orders (file #52.41)

 S ORD=0,GROUP=$P(PSORDSEQ("P"),"^")_"P^"_$P(PSORDSEQ("P"),"^",2)

 F  S ORD=$O(^PS(52.41,"P",PSODFN,ORD)) Q:'ORD  D

 . S TYPE=$$GET1^DIQ(52.41,ORD,2,"I")

 . I TYPE="DC"!(TYPE="DE")!(TYPE="HD") Q

 . S DRNAME="",DRUG=+$$GET1^DIQ(52.41,ORD,11,"I") I DRUG S DRNAME=$$GET1^DIQ(50,DRUG,.01)

 . I DRNAME="" D  Q:DRNAME=""

 . . S OI=$$GET1^DIQ(52.41,ORD,8,"I") I 'OI Q

 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)

 . S QTY=$$GET1^DIQ(52.41,ORD,12)

 . S STATUS=$$GET1^DIQ(52.41,ORD,2,"I")

 . S ISSDT=$$ISSDT^PSOPMP1(ORD,"P")

 . S REFREM=$$GET1^DIQ(52.41,ORD,13)

 . S DAYSUP=$$GET1^DIQ(52.41,ORD,101)

 . S RFRX="" I STATUS="RF" S RFRX=$$GET1^DIQ(52.41,ORD,21,"I") I RFRX S RFRX=$$GET1^DIQ(52,RFRX,.01)

 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,45),$P(Z,"^",4)=QTY,$P(Z,"^",5)=$E(STATUS,1,2)_$$CMOP^PSOPMP1(DRUG)

 . S $P(Z,"^",6)=$S(RFRX'="":"Rx#: "_RFRX,1:$P(ISSDT,"^",2)),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP

 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":+ISSDT_ORD,FIELD="LF":+ISSDT_ORD)

 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z

 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1

 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))

 ;

 ;Loading Non-VA Med orders (file #55, sub-file #55.05)

 S ORD=0,GROUP=$P(PSORDSEQ("N"),"^")_"N^"_$P(PSORDSEQ("N"),"^",2)

 F  S ORD=$O(^PS(55,PSODFN,"NVA",ORD)) Q:'ORD  D

 . I $$GET1^DIQ(55.05,ORD_","_PSODFN,5,"I") Q

 . S DRNAME=$$GET1^DIQ(55.05,ORD_","_PSODFN,1)

 . I DRNAME="" D  Q:DRNAME=""

 . . S OI=$$GET1^DIQ(55.05,ORD_","_PSODFN,.01,"I") I 'OI Q

 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)

 . S DOCDAT=$P($$GET1^DIQ(55.05,ORD_","_PSODFN_",",11,"I"),".")

 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,38),$P(Z,"^",7)=$$DAT^PSOPMP1(DOCDAT,"-")

 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":DOCDAT_ORD,FIELD="LF":DOCDAT_ORD)

 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z

 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1

 ;

 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))

 Q

 ;

RX ;Sort by Rx

 D SORT("RX")

 Q

DR ;Sort by Drug

 D SORT("DR")

 Q

ID ;Sort by Issue Date

 D SORT("ID")

 Q

LF ;Sort by Last Fill Date

 D SORT("LF")

 Q

 ;

SORT(FIELD) ;Sort entries by FIELD

 I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A")

 E  S PSOSRTBY=FIELD,PSORDER="A"

 D REF

 Q

 ;

REF ;Screen Refresh

 W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"

 Q

GS ;Group by Status

 W ?52,"Please wait..." S PSOSTSGP=$S($G(PSOSTSGP):0,1:1) D INIT,HDR S VALMBCK="R"

 Q

SIG ;Display SIG

 W ?52,"Please wait..." S PSOSIGDP=$S($G(PSOSIGDP):0,1:1) D INIT,HDR S VALMBCK="R"

 I 'PSOSIGDP S VALMBG=VALMBG\2

 I PSOSIGDP S VALMBG=VALMBG*2-1

 S:VALMBG>(VALMCNT-10) VALMBG=VALMCNT-10 S:VALMBG<1 VALMBG=1

 Q

PI ;Patient Information

 D EN^PSOLMPI S VALMBCK="R"

 Q

CV ;Change View

 D LST^PSOPMPPF(SITE,DUZ) W !?52,"Please wait..." D INIT,HDR

 S VALMBG=1,VALMBCK="R"

 Q

 ;

SEL ;Process selection of one entry

 N PSOSEL,TYPE,XQORM,ORD,TITLE

 S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q

 S TYPE=$O(^TMP("PSOPMP0",$J,PSOSEL,0)) I TYPE="" S VALMSG="Invalid selection!",VALMBCK="R" Q

 S ORD=$G(^TMP("PSOPMP0",$J,PSOSEL,TYPE))

 I 'ORD S VALMSG="Invalid selection!",VALMBCK="R" Q

 S TITLE=VALM("TITLE")

 ;

 ;Regular prescription

 I TYPE="RX" D  S VALMBCK="R" D REF

 . N PSOVDA,PSOSAVE,DA,PS

 . S (PSOVDA,DA)=ORD,PS="REJECTMP"

 . N LINE,TITLE,PSODFN D DP^PSORXVW

 ;

 ;Pending Order

 I TYPE="PEN" D  S VALMBCK="R" D REF

 . N PSOACTOV,OR0

 . S OR0=^PS(52.41,ORD,0),PSOACTOV=""

 . N LINE,TITLE D PENHDR^PSOPMP1(PSODFN),DSPL^PSOORFI1

 ;

 ;Pending Order

 I TYPE="NVA" D

 . N LINE,TITLE D EN^PSONVAVW(PSODFN,ORD)

 ;

 S VALMBCK="R",VALM("TITLE")=TITLE

 Q

 ;

EXIT ;

 K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J)

 Q

 ;

HELP Q

PSOPMP0   ;BIRM/MFR - Patient Medication Profile - Listmanager ;10/28/06

 +1       ;;7.0;OUTPATIENT PHARMACY;**260,281,303,289**;DEC 1997;Build 107

 +2       ;Reference to EN1^GMRADPT supported by IA #10099

 +3       ;Reference to EN6^GMRVUTL supported by IA #1120

 +4       ;Reference to ^PS(55 supported by DBIA 2228

 +5       ;

EN        ;Menu option entry point

 +1        NEW PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSIGDP,PSOSTSGP,PSOSTORD,PSORDCNT,PSOSTSEQ,PSORDSEQ,PSOCHNG

 +2        NEW GRPLN,DIC,Y,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT

 +3       ;

 +4       ;Division selection

 +5        IF '$GET(PSOSITE)

               DO ^PSOLSET

               IF '$DATA(PSOPAR)

                   WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!

                   GOTO EXIT

 +6       ;

 +7       ;Patient selection

 +8        WRITE !!

           SET DIC=2

           SET DIC(0)="QEAM"

           DO ^DIC

           IF Y<0

               GOTO EXIT

           SET DFN=+Y

 +9       ;bad address flag/update

           SET PSODFN=DFN

           DO CHKADDR^PSOBAI(DFN,1,1)

 +10       DO LST(PSOSITE,DFN)

 +11       QUIT 

 +12      ;

LST(SITE,PSODFN) ;ListManager entry point

 +1       ; Loading Division/User preferences

 +2        DO LOAD^PSOPMPPF(SITE,DUZ)

 +3        WRITE !,"Please wait..."

 +4        DO EN^VALM("PSO PMP MAIN")

 +5        DO FULL^VALM1

 +6        GOTO EXIT

 +7       ;

HDR       ;Header

 +1        NEW LINE,POS,LINE1,LINE2,LINE3,LINE4,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,GMRAL,ADVREA

 +2        KILL VADM

           SET DFN=PSODFN

           DO DEM^VADPT

 +3        SET PNAME=VADM(1)

 +4        SET DOB=$SELECT(+VADM(3):$PIECE(VADM(3),"^",2)_" ("_$GET(VADM(4))_")",1:"UNKNOWN")

 +5        SET SEX=$PIECE(VADM(5),"^",2)

 +6        SET (WT,X)=""

           SET GMRVSTR="WT"

           DO EN6^GMRVUTL

           IF X'=""

               SET WT=$JUSTIFY($PIECE(X,"^",8)/2.2,6,2)

               SET WTDT=$$DAT^PSOPMP1($PIECE(X,"^")\1,"/",1)

 +7        SET (HT,X)=""

           SET GMRVSTR="HT"

           DO EN6^GMRVUTL

           IF X'=""

               SET HT=$JUSTIFY($PIECE(X,"^",8)*2.54,6,2)

               SET HTDT=$$DAT^PSOPMP1($PIECE(X,"^")\1,"/",1)

 +8        SET LINE1=PNAME

 +9        SET LINE1=$$ALLERGY^PSOPMP1(LINE1,DFN)

 +10       SET LINE2="  PID: "_$PIECE(VADM(2),"^",2)

           SET $EXTRACT(LINE2,50)="HEIGHT(cm): "_$SELECT(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE")

 +11       SET LINE3="  DOB: "_DOB

           SET $EXTRACT(LINE3,50)="WEIGHT(kg): "_$SELECT(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE")

 +12       SET LINE4="  SEX: "_SEX

           SET $EXTRACT(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS"

 +13      ;

 +14       KILL VALMHDR

           SET VALMHDR(1)=LINE1

           SET VALMHDR(2)=LINE2

           SET VALMHDR(3)=LINE3

           SET VALMHDR(4)=LINE4

 +15       DO SETHDR^PSOPMP1()

 +16       QUIT 

 +17      ;

INIT      ;Populates the Body section for ListMan

 +1        KILL ^TMP("PSOPMP0",$JOB),^TMP("PSOPMPSR",$JOB)

 +2        DO SETSORT(PSOSRTBY)

           DO SETLINE

 +3        SET VALMSG="Select the entry # to view or ?? for more actions"

 +4        QUIT 

 +5       ;

SETLINE   ;Sets the line to be displayed in ListMan

 +1        NEW TYPE,STS,SUB,SEQ,LINE,Z,TOTAL,I,X,X1,ORDCNT,LBL,LN,IENSUB,GROUP,GRP,QTYL

 +2        IF '$DATA(^TMP("PSOPMPSR",$JOB))

               Begin DoDot:1

 +3                FOR I=1:1:6

                       SET ^TMP("PSOPMP0",$JOB,I,0)=""

 +4                SET ^TMP("PSOPMP0",$JOB,7,0)="                    No prescriptions found for this patient."

 +5                SET VALMCNT=1

               End DoDot:1

               QUIT 

 +6       ;

 +7       ;Resetting list to NORMAL video attributes

 +8        FOR I=1:1:$GET(LASTLINE)

               DO RESTORE^VALM10(I)

 +9        KILL GRPLN,HIGHLN

 +10      ;Building the list (line by line)

 +11       SET (GROUP,STS,SUB)=""

           SET LINE=0

           KILL ^TMP("PSOPMP0",$JOB)

 +12       FOR 

               SET GROUP=$ORDER(^TMP("PSOPMPSR",$JOB,GROUP))

               IF GROUP=""

                   QUIT 

               Begin DoDot:1

 +13               SET GRP=$PIECE(GROUP,"^")

 +14               IF GRP'["R"!('PSOSTSGP&($ORDER(^TMP("PSOPMPSR",$JOB,GROUP),-1)'=""))

                       Begin DoDot:2

 +15                       DO GROUP^PSOPMP1($PIECE(GROUP,"^",2),+$GET(^TMP("PSOPMPSR",$JOB,GROUP)),.LINE)

                       End DoDot:2

 +16               FOR 

                       SET STS=$ORDER(^TMP("PSOPMPSR",$JOB,GROUP,STS))

                       IF STS=""

                           QUIT 

                       Begin DoDot:2

 +17                       IF STS'="<NULL>"

                               Begin DoDot:3

 +18                               DO GROUP^PSOPMP1($PIECE(STS,"^",2),+$GET(^TMP("PSOPMPSR",$JOB,GROUP,STS)),.LINE)

                               End DoDot:3

 +19                       FOR 

                               SET SUB=$ORDER(^TMP("PSOPMPSR",$JOB,GROUP,STS,SUB),$SELECT(PSORDER="A":1,1:-1))

                               IF SUB=""

                                   QUIT 

                               Begin DoDot:3

 +20                               SET Z=$GET(^TMP("PSOPMPSR",$JOB,GROUP,STS,SUB))

 +21                               SET X1=""

                                   SET SEQ=$GET(SEQ)+1

                                   SET X1=$JUSTIFY(SEQ,3)

 +22                               SET QTYL=$LENGTH($PIECE(Z,"^",4))

                                   IF QTYL<5

                                       SET QTYL=5

 +23                               IF GRP["R"!(GRP["T")

                                       SET $EXTRACT(X1,5)=$PIECE(Z,"^",2)

                                       SET $EXTRACT(X1,19)=$EXTRACT($PIECE(Z,"^",3),1,(32-QTYL))

 +24                               IF GRP["P"!(GRP["N")

                                       SET $EXTRACT(X1,5)=$PIECE(Z,"^",3)

 +25                               IF GRP["N"

                                       SET $EXTRACT(X1,49)="Date Documented:"

 +26                               IF GRP'["N"

                                       SET $EXTRACT(X1,52-QTYL)=$JUSTIFY($PIECE(Z,"^",4),QTYL)

                                       SET $EXTRACT(X1,53)=$PIECE(Z,"^",5)

                                       SET $EXTRACT(X1,57)=$PIECE(Z,"^",6)

 +27                               SET $EXTRACT(X1,66)=$PIECE(Z,"^",7)

 +28                               SET $EXTRACT(X1,74)=$JUSTIFY($PIECE(Z,"^",8),3)

                                   SET $EXTRACT(X1,78)=$JUSTIFY($PIECE(Z,"^",9),3)

 +29                               SET LINE=LINE+1

                                   SET ^TMP("PSOPMP0",$JOB,LINE,0)=X1

                                   SET HIGHLN(LINE)=""

 +30                               SET IENSUB=$SELECT(GRP["R"!(GRP["T"):"RX",GRP["P":"PEN",1:"NVA")

 +31                               SET ^TMP("PSOPMP0",$JOB,SEQ,IENSUB)=$PIECE(Z,"^")

 +32                               IF IENSUB="PEN"&($PIECE($GET(^PS(52.41,+$PIECE(Z,"^"),0)),"^",23)=1)

                                       SET ^TMP("PSOPMP0",$JOB,LINE,"RV")=1

 +33                               IF $GET(PSOSIGDP)

                                       DO SETSIG^PSOPMP1($SELECT(GRP["R"!(GRP["T"):"R",GRP["P":"P",1:"N"),+Z,.LINE,PSODFN)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34      ;

 +35      ;Saving NORMAL video attributes to be reset later

 +36       IF LINE>$GET(LASTLINE)

               Begin DoDot:1

 +37               FOR I=($GET(LASTLINE)+1):1:LINE

                       DO SAVE^VALM10(I)

 +38               SET LASTLINE=LINE

               End DoDot:1

 +39       DO VIDEO^PSOPMP1()

 +40       SET VALMCNT=+$GET(LINE)

           DO RV^PSOPMP1

 +41       QUIT 

 +42      ;

SETSORT(FIELD) ;Sets the data sorted by the FIELD specified

 +1        NEW SEQ,RX,RXNUM,DRUG,DRNAME,QTY,STATUS,STS,ISSDT,DOCDAT,LSTFD,REFREM,DAYSUP,SIG,Z,ORD,GRPCNT,GROUP,RFRX,OI,PSOBADR

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

 +3       ;Loading prescription (file #55)

 +4        SET SEQ=0

 +5        FOR 

               SET SEQ=$ORDER(^PS(55,PSODFN,"P",SEQ))

               IF 'SEQ

                   QUIT 

               Begin DoDot:1

 +6                SET RX=+$GET(^PS(55,PSODFN,"P",SEQ,0))

                   IF 'RX!($GET(^PSRX(RX,0))="")

                       QUIT 

 +7                IF $$FILTER^PSOPMP1(RX)

                       QUIT 

 +8                SET RXNUM=$$GET1^DIQ(52,RX,.01)

 +9                SET DRUG=$$GET1^DIQ(52,RX,6,"I")

 +10               SET DRNAME=$$GET1^DIQ(50,DRUG,.01)

 +11               SET QTY=$$GET1^DIQ(52,RX,7)

 +12               SET STATUS=$$STSINFO^PSOPMP1(RX)

 +13               SET ISSDT=$$ISSDT^PSOPMP1(RX,"R")

 +14               SET LSTFD=$$LSTFD^PSOPMP1(RX)

 +15               SET REFREM=$$REFREM^PSOPMP1(RX)

 +16               SET DAYSUP=$$GET1^DIQ(52,RX,8)

 +17               SET PSOBADR=$ORDER(^PSRX(RX,"L",9999),-1)

 +18               IF PSOBADR'=""

                       SET PSOBADR=$GET(^PSRX(RX,"L",PSOBADR,0))

                       IF PSOBADR["(BAD ADDRESS)"

                           SET PSOBADR="B"

 +19               IF PSOBADR'="B"

                       SET PSOBADR=""

 +20               SET Z=""

                   SET $PIECE(Z,"^")=RX

                   SET $PIECE(Z,"^",2)=RXNUM_$$COPAY^PSOPMP1(RX)_$$ECME^PSOBPSUT(RX)

                   SET $PIECE(Z,"^",3)=$EXTRACT(DRNAME,1,30)

 +21               SET $PIECE(Z,"^",4)=QTY

                   SET $PIECE(Z,"^",5)=$PIECE(STATUS,"^",3)_$$CMOP^PSOPMP1(DRUG,RX)_PSOBADR

                   SET $PIECE(Z,"^",6)=$PIECE(ISSDT,"^",2)

 +22               SET $PIECE(Z,"^",7)=$PIECE(LSTFD,"^",2)

                   SET $PIECE(Z,"^",8)=REFREM

                   SET $PIECE(Z,"^",9)=DAYSUP

 +23               SET SORT=$SELECT(FIELD="RX":RXNUM_" ",FIELD="DR":DRNAME_RXNUM,FIELD="ID":+ISSDT_RXNUM_" ",FIELD="LF":+LSTFD_RXNUM_" ")

 +24               SET STS="<NULL>"

                   IF $GET(PSOSTSGP)

                       SET STS=$PIECE(STATUS,"^")_"^"_$PIECE(STATUS,"^",2)

 +25               SET GROUP=$PIECE(PSORDSEQ("R"),"^")_"R^"_$PIECE(PSORDSEQ("R"),"^",2)

 +26               IF $$FIND^PSOREJUT(RX,,,"79,88")

                       SET GROUP=$PIECE(PSORDSEQ("T"),"^")_"T^"_$PIECE(PSORDSEQ("T"),"^",2)

                       SET STS="<NULL>"

 +27               SET ^TMP("PSOPMPSR",$JOB,GROUP,STS,SORT)=Z

 +28               SET GRPCNT(GROUP)=$GET(GRPCNT(GROUP))+1

                   SET GRPCNT(GROUP,STS)=$GET(GRPCNT(GROUP,STS))+1

               End DoDot:1

 +29      ;

 +30       SET GROUP=""

 +31       FOR 

               SET GROUP=$ORDER(GRPCNT(GROUP))

               IF GROUP=""

                   QUIT 

               Begin DoDot:1

 +32               SET ^TMP("PSOPMPSR",$JOB,GROUP)=$GET(GRPCNT(GROUP))

 +33               SET STS=""

                   FOR 

                       SET STS=$ORDER(GRPCNT(GROUP,STS))

                       IF STS=""

                           QUIT 

                       Begin DoDot:2

 +34                       SET ^TMP("PSOPMPSR",$JOB,GROUP,STS)=GRPCNT(GROUP,STS)

                       End DoDot:2

               End DoDot:1

 +35      ;

 +36      ;Loading pending orders (file #52.41)

 +37       SET ORD=0

           SET GROUP=$PIECE(PSORDSEQ("P"),"^")_"P^"_$PIECE(PSORDSEQ("P"),"^",2)

 +38       FOR 

               SET ORD=$ORDER(^PS(52.41,"P",PSODFN,ORD))

               IF 'ORD

                   QUIT 

               Begin DoDot:1

 +39               SET TYPE=$$GET1^DIQ(52.41,ORD,2,"I")

 +40               IF TYPE="DC"!(TYPE="DE")!(TYPE="HD")

                       QUIT 

 +41               SET DRNAME=""

                   SET DRUG=+$$GET1^DIQ(52.41,ORD,11,"I")

                   IF DRUG

                       SET DRNAME=$$GET1^DIQ(50,DRUG,.01)