- PSOPMP0 ;BIRM/MFR - Patient Medication Profile - Listmanager ;10/28/06
- ;;7.0;OUTPATIENT PHARMACY;**260,281,303,289,382,313,427,500,482,570,562**;DEC 1997;Build 19
- ;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.2046226,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,ORNUM1,ERXIEN1
- 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)
- . . . I GRP'["P" K ERXIEN1 S ORNUM1=$$GET1^DIQ(52,+Z,39.3,"I") D:ORNUM1 S X1=X1_$S($G(ERXIEN1):"& ",1:"")
- . . . . S ERXIEN1=$$CHKERX^PSOERXU1(ORNUM1)
- . . . S QTYL=$L($P(Z,"^",4)) S:QTYL<5 QTYL=5
- . . . I GRP["R"!(GRP["T")!(GRP["H") S $E(X1,$S($G(ERXIEN1):6,1:5))=$P(Z,"^",2),$E(X1,19)=$E($P(Z,"^",3),1,(32-QTYL))
- . . . I GRP["P"!(GRP["N") K ERXIEN1 S ORNUM1=$$GET1^DIQ(52.41,+Z,.01,"I") D:ORNUM1 S $E(X1,4)=$S($G(ERXIEN1):"& ",1:" ")_$P(Z,"^",3)
- . . . . S ERXIEN1=$$CHKERX^PSOERXU1(ORNUM1)
- . . . 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")!(GRP["H"):"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")!(GRP["H"):"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,RDREJ
- 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)_$$TITRX^PSOUTL(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)
- . ; PSO*427 changes for RRR/TRI/CVA reject display
- . S RDREJ=0 ; initialize RTS/DUR reject flag to 0
- . I $$FIND^PSOREJUT(RX,,,"79,88,943") S GROUP=$P(PSORDSEQ("T"),"^")_"T^"_$P(PSORDSEQ("T"),"^",2),STS="<NULL>",RDREJ=1
- . ; next look for any unresolved TRI/CVA rejects *427
- . I 'RDREJ,$$TRIC^PSOREJP1(RX),$$FIND^PSOREJUT(RX,,,,1) S GROUP=$P(PSORDSEQ("H"),U,1)_"H^"_$P(PSORDSEQ("H"),U,2),STS="<NULL>"
- . ; next look for any unresolved RRR rejects *427
- . I 'RDREJ,'$$TRIC^PSOREJP1(RX),$$FIND^PSOREJUT(RX,,,,,1) S GROUP=$P(PSORDSEQ("H"),U,1)_"H^"_$P(PSORDSEQ("H"),U,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,PSOLIS,XX
- S PSOLIS=$P(XQORNOD(0),"=",2) I 'PSOLIS S VALMSG="Invalid selection!",VALMBCK="R" Q
- F XX=1:1:$L(PSOLIS,",") Q:$P(PSOLIS,",",XX)']"" D
- .S PSOSEL=+$P(PSOLIS,",",XX) 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
- ;
- MEDPRO(RXIEN,FILL) ; MP Medication Profile
- ;
- ; This procedure relies on existing procedures which are part
- ; of Patient Medication Profile ListMan screen.
- ;
- ; New variables used in this procedure.
- ;
- N PSODFN,PSOSIGDP,PSOSITE,PSOSRTBY
- ;
- K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J)
- ;
- ; Determine Division IEN, ptr to file# 59, and Patient IEN.
- ;
- S PSOSITE=+$$RXSITE^PSOBPSUT(RXIEN,FILL)
- S PSODFN=+$$GET1^DIQ(52,RXIEN,2,"I")
- ;
- ; LOAD determines Division or User preferences.
- ;
- D LOAD^PSOPMPPF(PSOSITE,DUZ)
- S PSOSIGDP=0 ; Do not include signature info.
- ;
- ; SETSORT collects medication data into ^TMP("PSOPMPSR").
- ; SETLINE takes the data collected in ^TMP("PSOPMPSR") and
- ; creates the display lines in ^TMP("PSOPMP0").
- ;
- D SETSORT(PSOSRTBY)
- D SETLINE
- ;
- K ^TMP("PSOPMPSR",$J)
- ;
- ; Clean up variable set but neither Newed nor Killed in LOAD^PSOPMPPF.
- ;
- K PSOEXDCE,PSORDCNT,PSORDER,PSOSRTBY,PSOSTSEQ,PSOSTSGP
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPMP0 12017 printed Feb 18, 2025@23:59:10 Page 2
- PSOPMP0 ;BIRM/MFR - Patient Medication Profile - Listmanager ;10/28/06
- +1 ;;7.0;OUTPATIENT PHARMACY;**260,281,303,289,382,313,427,500,482,570,562**;DEC 1997;Build 19
- +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.2046226,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,ORNUM1,ERXIEN1
- +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 IF GRP'["P"
- KILL ERXIEN1
- SET ORNUM1=$$GET1^DIQ(52,+Z,39.3,"I")
- if ORNUM1
- Begin DoDot:4
- +23 SET ERXIEN1=$$CHKERX^PSOERXU1(ORNUM1)
- End DoDot:4
- SET X1=X1_$SELECT($GET(ERXIEN1):"& ",1:"")
- +24 SET QTYL=$LENGTH($PIECE(Z,"^",4))
- if QTYL<5
- SET QTYL=5
- +25 IF GRP["R"!(GRP["T")!(GRP["H")
- SET $EXTRACT(X1,$SELECT($GET(ERXIEN1):6,1:5))=$PIECE(Z,"^",2)
- SET $EXTRACT(X1,19)=$EXTRACT($PIECE(Z,"^",3),1,(32-QTYL))
- +26 IF GRP["P"!(GRP["N")
- KILL ERXIEN1
- SET ORNUM1=$$GET1^DIQ(52.41,+Z,.01,"I")
- if ORNUM1
- Begin DoDot:4
- +27 SET ERXIEN1=$$CHKERX^PSOERXU1(ORNUM1)
- End DoDot:4
- SET $EXTRACT(X1,4)=$SELECT($GET(ERXIEN1):"& ",1:" ")_$PIECE(Z,"^",3)
- +28 IF GRP["N"
- SET $EXTRACT(X1,49)="Date Documented:"
- +29 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)
- +30 SET $EXTRACT(X1,66)=$PIECE(Z,"^",7)
- +31 SET $EXTRACT(X1,74)=$JUSTIFY($PIECE(Z,"^",8),3)
- SET $EXTRACT(X1,78)=$JUSTIFY($PIECE(Z,"^",9),3)
- +32 SET LINE=LINE+1
- SET ^TMP("PSOPMP0",$JOB,LINE,0)=X1
- SET HIGHLN(LINE)=""
- +33 SET IENSUB=$SELECT(GRP["R"!(GRP["T")!(GRP["H"):"RX",GRP["P":"PEN",1:"NVA")
- +34 SET ^TMP("PSOPMP0",$JOB,SEQ,IENSUB)=$PIECE(Z,"^")
- +35 IF IENSUB="PEN"&($PIECE($GET(^PS(52.41,+$PIECE(Z,"^"),0)),"^",23)=1)
- SET ^TMP("PSOPMP0",$JOB,LINE,"RV")=1
- +36 IF $GET(PSOSIGDP)
- DO SETSIG^PSOPMP1($SELECT(GRP["R"!(GRP["T")!(GRP["H"):"R",GRP["P":"P",1:"N"),+Z,.LINE,PSODFN)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +37 ;
- +38 ;Saving NORMAL video attributes to be reset later
- +39 IF LINE>$GET(LASTLINE)
- Begin DoDot:1
- +40 FOR I=($GET(LASTLINE)+1):1:LINE
- DO SAVE^VALM10(I)
- +41 SET LASTLINE=LINE
- End DoDot:1
- +42 DO VIDEO^PSOPMP1()
- +43 SET VALMCNT=+$GET(LINE)
- DO RV^PSOPMP1
- +44 QUIT
- +45 ;
- 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,RDREJ
- +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)_$$TITRX^PSOUTL(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 ; PSO*427 changes for RRR/TRI/CVA reject display
- +27 ; initialize RTS/DUR reject flag to 0
- SET RDREJ=0
- +28 IF $$FIND^PSOREJUT(RX,,,"79,88,943")
- SET GROUP=$PIECE(PSORDSEQ("T"),"^")_"T^"_$PIECE(PSORDSEQ("T"),"^",2)
- SET STS="<NULL>"
- SET RDREJ=1
- +29 ; next look for any unresolved TRI/CVA rejects *427
- +30 IF 'RDREJ
- IF $$TRIC^PSOREJP1(RX)
- IF $$FIND^PSOREJUT(RX,,,,1)
- SET GROUP=$PIECE(PSORDSEQ("H"),U,1)_"H^"_$PIECE(PSORDSEQ("H"),U,2)
- SET STS="<NULL>"
- +31 ; next look for any unresolved RRR rejects *427
- +32 IF 'RDREJ
- IF '$$TRIC^PSOREJP1(RX)
- IF $$FIND^PSOREJUT(RX,,,,,1)
- SET GROUP=$PIECE(PSORDSEQ("H"),U,1)_"H^"_$PIECE(PSORDSEQ("H"),U,2)
- SET STS="<NULL>"
- +33 SET ^TMP("PSOPMPSR",$JOB,GROUP,STS,SORT)=Z
- +34 SET GRPCNT(GROUP)=$GET(GRPCNT(GROUP))+1
- SET GRPCNT(GROUP,STS)=$GET(GRPCNT(GROUP,STS))+1
- End DoDot:1
- +35 ;
- +36 SET GROUP=""
- +37 FOR
- SET GROUP=$ORDER(GRPCNT(GROUP))
- if GROUP=""
- QUIT
- Begin DoDot:1
- +38 SET ^TMP("PSOPMPSR",$JOB,GROUP)=$GET(GRPCNT(GROUP))
- +39 SET STS=""
- FOR
- SET STS=$ORDER(GRPCNT(GROUP,STS))
- if STS=""
- QUIT
- Begin DoDot:2
- +40 SET ^TMP("PSOPMPSR",$JOB,GROUP,STS)=GRPCNT(GROUP,STS)
- End DoDot:2
- End DoDot:1
- +41 ;
- +42 ;Loading pending orders (file #52.41)
- +43 SET ORD=0
- SET GROUP=$PIECE(PSORDSEQ("P"),"^")_"P^"_$PIECE(PSORDSEQ("P"),"^",2)
- +44 FOR
- SET ORD=$ORDER(^PS(52.41,"P",PSODFN,ORD))
- if 'ORD
- QUIT
- Begin DoDot:1
- +45 SET TYPE=$$GET1^DIQ(52.41,ORD,2,"I")
- +46 IF TYPE="DC"!(TYPE="DE")!(TYPE="HD")
- QUIT
- +47 SET DRNAME=""
- SET DRUG=+$$GET1^DIQ(52.41,ORD,11,"I")
- IF DRUG
- SET DRNAME=$$GET1^DIQ(50,DRUG,.01)
- +48 IF DRNAME=""
- Begin DoDot:2
- +49 SET OI=$$GET1^DIQ(52.41,ORD,8,"I")
- IF 'OI
- QUIT
- +50 SET DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)
- End DoDot:2
- if DRNAME=""
- QUIT
- +51 SET QTY=$$GET1^DIQ(52.41,ORD,12)
- +52 SET STATUS=$$GET1^DIQ(52.41,ORD,2,"I")
- +53 SET ISSDT=$$ISSDT^PSOPMP1(ORD,"P")
- +54 SET REFREM=$$GET1^DIQ(52.41,ORD,13)
- +55 SET DAYSUP=$$GET1^DIQ(52.41,ORD,101)
- +56 SET RFRX=""
- IF STATUS="RF"
- SET RFRX=$$GET1^DIQ(52.41,ORD,21,"I")
- IF RFRX
- SET RFRX=$$GET1^DIQ(52,RFRX,.01)
- +57 SET Z=""
- SET $PIECE(Z,"^")=ORD
- SET $PIECE(Z,"^",3)=$EXTRACT(DRNAME,1,45)
- SET $PIECE(Z,"^",4)=QTY
- SET $PIECE(Z,"^",5)=$EXTRACT(STATUS,1,2)_$$CMOP^PSOPMP1(DRUG)
- +58 SET $PIECE(Z,"^",6)=$SELECT(RFRX'="":"Rx#: "_RFRX,1:$PIECE(ISSDT,"^",2))
- SET $PIECE(Z,"^",8)=REFREM
- SET $PIECE(Z,"^",9)=DAYSUP
- +59 SET SORT=$SELECT(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":+ISSDT_ORD,FIELD="LF":+ISSDT_ORD)
- +60 SET ^TMP("PSOPMPSR",$JOB,GROUP,"<NULL>",SORT)=Z
- +61 SET GRPCNT(GROUP)=$GET(GRPCNT(GROUP))+1
- End DoDot:1
- +62 if $GET(GRPCNT(GROUP))
- SET ^TMP("PSOPMPSR",$JOB,GROUP)=$GET(GRPCNT(GROUP))
- +63 ;
- +64 ;Loading Non-VA Med orders (file #55, sub-file #55.05)
- +65 SET ORD=0
- SET GROUP=$PIECE(PSORDSEQ("N"),"^")_"N^"_$PIECE(PSORDSEQ("N"),"^",2)
- +66 FOR
- SET ORD=$ORDER(^PS(55,PSODFN,"NVA",ORD))
- if 'ORD
- QUIT
- Begin DoDot:1
- +67 IF $$GET1^DIQ(55.05,ORD_","_PSODFN,5,"I")
- QUIT
- +68 SET DRNAME=$$GET1^DIQ(55.05,ORD_","_PSODFN,1)
- +69 IF DRNAME=""
- Begin DoDot:2
- +70 SET OI=$$GET1^DIQ(55.05,ORD_","_PSODFN,.01,"I")
- IF 'OI
- QUIT
- +71 SET DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)
- End DoDot:2
- if DRNAME=""
- QUIT
- +72 SET DOCDAT=$PIECE($$GET1^DIQ(55.05,ORD_","_PSODFN_",",11,"I"),".")
- +73 SET Z=""
- SET $PIECE(Z,"^")=ORD
- SET $PIECE(Z,"^",3)=$EXTRACT(DRNAME,1,38)
- SET $PIECE(Z,"^",7)=$$DAT^PSOPMP1(DOCDAT,"-")
- +74 SET SORT=$SELECT(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":DOCDAT_ORD,FIELD="LF":DOCDAT_ORD)
- +75 SET ^TMP("PSOPMPSR",$JOB,GROUP,"<NULL>",SORT)=Z
- +76 SET GRPCNT(GROUP)=$GET(GRPCNT(GROUP))+1
- End DoDot:1
- +77 ;
- +78 if $GET(GRPCNT(GROUP))
- SET ^TMP("PSOPMPSR",$JOB,GROUP)=$GET(GRPCNT(GROUP))
- +79 QUIT
- +80 ;
- RX ;Sort by Rx
- +1 DO SORT("RX")
- +2 QUIT
- DR ;Sort by Drug
- +1 DO SORT("DR")
- +2 QUIT
- ID ;Sort by Issue Date
- +1 DO SORT("ID")
- +2 QUIT
- LF ;Sort by Last Fill Date
- +1 DO SORT("LF")
- +2 QUIT
- +3 ;
- SORT(FIELD) ;Sort entries by FIELD
- +1 IF PSOSRTBY=FIELD
- SET PSORDER=$SELECT(PSORDER="A":"D",1:"A")
- +2 IF '$TEST
- SET PSOSRTBY=FIELD
- SET PSORDER="A"
- +3 DO REF
- +4 QUIT
- +5 ;
- REF ;Screen Refresh
- +1 WRITE ?52,"Please wait..."
- DO INIT
- DO HDR
- SET VALMBCK="R"
- +2 QUIT
- GS ;Group by Status
- +1 WRITE ?52,"Please wait..."
- SET PSOSTSGP=$SELECT($GET(PSOSTSGP):0,1:1)
- DO INIT
- DO HDR
- SET VALMBCK="R"
- +2 QUIT
- SIG ;Display SIG
- +1 WRITE ?52,"Please wait..."
- SET PSOSIGDP=$SELECT($GET(PSOSIGDP):0,1:1)
- DO INIT
- DO HDR
- SET VALMBCK="R"
- +2 IF 'PSOSIGDP
- SET VALMBG=VALMBG\2
- +3 IF PSOSIGDP
- SET VALMBG=VALMBG*2-1
- +4 if VALMBG>(VALMCNT-10)
- SET VALMBG=VALMCNT-10
- if VALMBG<1
- SET VALMBG=1
- +5 QUIT
- PI ;Patient Information
- +1 DO EN^PSOLMPI
- SET VALMBCK="R"
- +2 QUIT
- CV ;Change View
- +1 DO LST^PSOPMPPF(SITE,DUZ)
- WRITE !?52,"Please wait..."
- DO INIT
- DO HDR
- +2 SET VALMBG=1
- SET VALMBCK="R"
- +3 QUIT
- +4 ;
- SEL ;Process selection of one entry
- +1 NEW PSOSEL,TYPE,XQORM,ORD,TITLE,PSOLIS,XX
- +2 SET PSOLIS=$PIECE(XQORNOD(0),"=",2)
- IF 'PSOLIS
- SET VALMSG="Invalid selection!"
- SET VALMBCK="R"
- QUIT
- +3 FOR XX=1:1:$LENGTH(PSOLIS,",")
- if $PIECE(PSOLIS,",",XX)']""
- QUIT
- Begin DoDot:1
- +4 SET PSOSEL=+$PIECE(PSOLIS,",",XX)
- IF 'PSOSEL
- SET VALMSG="Invalid selection!"
- SET VALMBCK="R"
- QUIT
- +5 SET TYPE=$ORDER(^TMP("PSOPMP0",$JOB,PSOSEL,0))
- IF TYPE=""
- SET VALMSG="Invalid selection!"
- SET VALMBCK="R"
- QUIT
- +6 SET ORD=$GET(^TMP("PSOPMP0",$JOB,PSOSEL,TYPE))
- +7 IF 'ORD
- SET VALMSG="Invalid selection!"
- SET VALMBCK="R"
- QUIT
- +8 SET TITLE=VALM("TITLE")
- +9 ;
- +10 ;Regular prescription
- +11 IF TYPE="RX"
- Begin DoDot:2
- +12 NEW PSOVDA,PSOSAVE,DA,PS
- +13 SET (PSOVDA,DA)=ORD
- SET PS="REJECTMP"
- +14 NEW LINE,TITLE,PSODFN
- DO DP^PSORXVW
- End DoDot:2
- SET VALMBCK="R"
- DO REF
- +15 ;
- +16 ;Pending Order
- +17 IF TYPE="PEN"
- Begin DoDot:2
- +18 NEW PSOACTOV,OR0
- +19 SET OR0=^PS(52.41,ORD,0)
- SET PSOACTOV=""
- +20 NEW LINE,TITLE
- DO PENHDR^PSOPMP1(PSODFN)
- DO DSPL^PSOORFI1
- End DoDot:2
- SET VALMBCK="R"
- DO REF
- +21 ;
- +22 ;Pending Order
- +23 IF TYPE="NVA"
- Begin DoDot:2
- +24 NEW LINE,TITLE
- DO EN^PSONVAVW(PSODFN,ORD)
- End DoDot:2
- +25 ;
- End DoDot:1
- +26 SET VALMBCK="R"
- SET VALM("TITLE")=TITLE
- +27 QUIT
- +28 ;
- EXIT ;
- +1 KILL ^TMP("PSOPMP0",$JOB),^TMP("PSOPMPSR",$JOB)
- +2 QUIT
- +3 ;
- HELP QUIT
- +1 ;
- MEDPRO(RXIEN,FILL) ; MP Medication Profile
- +1 ;
- +2 ; This procedure relies on existing procedures which are part
- +3 ; of Patient Medication Profile ListMan screen.
- +4 ;
- +5 ; New variables used in this procedure.
- +6 ;
- +7 NEW PSODFN,PSOSIGDP,PSOSITE,PSOSRTBY
- +8 ;
- +9 KILL ^TMP("PSOPMP0",$JOB),^TMP("PSOPMPSR",$JOB)
- +10 ;
- +11 ; Determine Division IEN, ptr to file# 59, and Patient IEN.
- +12 ;
- +13 SET PSOSITE=+$$RXSITE^PSOBPSUT(RXIEN,FILL)
- +14 SET PSODFN=+$$GET1^DIQ(52,RXIEN,2,"I")
- +15 ;
- +16 ; LOAD determines Division or User preferences.
- +17 ;
- +18 DO LOAD^PSOPMPPF(PSOSITE,DUZ)
- +19 ; Do not include signature info.
- SET PSOSIGDP=0
- +20 ;
- +21 ; SETSORT collects medication data into ^TMP("PSOPMPSR").
- +22 ; SETLINE takes the data collected in ^TMP("PSOPMPSR") and
- +23 ; creates the display lines in ^TMP("PSOPMP0").
- +24 ;
- +25 DO SETSORT(PSOSRTBY)
- +26 DO SETLINE
- +27 ;
- +28 KILL ^TMP("PSOPMPSR",$JOB)
- +29 ;
- +30 ; Clean up variable set but neither Newed nor Killed in LOAD^PSOPMPPF.
- +31 ;
- +32 KILL PSOEXDCE,PSORDCNT,PSORDER,PSOSRTBY,PSOSTSEQ,PSOSTSGP
- +33 ;
- +34 QUIT