Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOPMP0

PSOPMP0.m

Go to the documentation of this file.
  1. 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
  1. ;Reference to EN1^GMRADPT supported by IA #10099
  1. ;Reference to EN6^GMRVUTL supported by IA #1120
  1. ;Reference to ^PS(55 supported by DBIA 2228
  1. ;
  1. EN ;Menu option entry point
  1. N PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSIGDP,PSOSTSGP,PSOSTORD,PSORDCNT,PSOSTSEQ,PSORDSEQ,PSOCHNG
  1. N GRPLN,DIC,Y,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT
  1. ;
  1. ;Division selection
  1. I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
  1. ;
  1. ;Patient selection
  1. W !! S DIC=2,DIC(0)="QEAM" D ^DIC G EXIT:Y<0 S DFN=+Y
  1. S PSODFN=DFN D CHKADDR^PSOBAI(DFN,1,1) ;bad address flag/update
  1. D LST(PSOSITE,DFN)
  1. Q
  1. ;
  1. LST(SITE,PSODFN) ;ListManager entry point
  1. ; Loading Division/User preferences
  1. D LOAD^PSOPMPPF(SITE,DUZ)
  1. W !,"Please wait..."
  1. D EN^VALM("PSO PMP MAIN")
  1. D FULL^VALM1
  1. G EXIT
  1. ;
  1. HDR ;Header
  1. N LINE,POS,LINE1,LINE2,LINE3,LINE4,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,GMRAL,ADVREA
  1. K VADM S DFN=PSODFN D DEM^VADPT
  1. S PNAME=VADM(1)
  1. S DOB=$S(+VADM(3):$P(VADM(3),"^",2)_" ("_$G(VADM(4))_")",1:"UNKNOWN")
  1. S SEX=$P(VADM(5),"^",2)
  1. 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)
  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)
  1. S LINE1=PNAME
  1. S LINE1=$$ALLERGY^PSOPMP1(LINE1,DFN)
  1. S LINE2=" PID: "_$P(VADM(2),"^",2),$E(LINE2,50)="HEIGHT(cm): "_$S(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE")
  1. S LINE3=" DOB: "_DOB,$E(LINE3,50)="WEIGHT(kg): "_$S(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE")
  1. S LINE4=" SEX: "_SEX,$E(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS"
  1. ;
  1. K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2,VALMHDR(3)=LINE3,VALMHDR(4)=LINE4
  1. D SETHDR^PSOPMP1()
  1. Q
  1. ;
  1. INIT ;Populates the Body section for ListMan
  1. K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J)
  1. D SETSORT(PSOSRTBY),SETLINE
  1. S VALMSG="Select the entry # to view or ?? for more actions"
  1. Q
  1. ;
  1. SETLINE ;Sets the line to be displayed in ListMan
  1. N TYPE,STS,SUB,SEQ,LINE,Z,TOTAL,I,X,X1,ORDCNT,LBL,LN,IENSUB,GROUP,GRP,QTYL,ORNUM1,ERXIEN1
  1. I '$D(^TMP("PSOPMPSR",$J)) D Q
  1. . F I=1:1:6 S ^TMP("PSOPMP0",$J,I,0)=""
  1. . S ^TMP("PSOPMP0",$J,7,0)=" No prescriptions found for this patient."
  1. . S VALMCNT=1
  1. ;
  1. ;Resetting list to NORMAL video attributes
  1. F I=1:1:$G(LASTLINE) D RESTORE^VALM10(I)
  1. K GRPLN,HIGHLN
  1. ;Building the list (line by line)
  1. S (GROUP,STS,SUB)="",LINE=0 K ^TMP("PSOPMP0",$J)
  1. F S GROUP=$O(^TMP("PSOPMPSR",$J,GROUP)) Q:GROUP="" D
  1. . S GRP=$P(GROUP,"^")
  1. . I GRP'["R"!('PSOSTSGP&($O(^TMP("PSOPMPSR",$J,GROUP),-1)'="")) D
  1. . . D GROUP^PSOPMP1($P(GROUP,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP)),.LINE)
  1. . F S STS=$O(^TMP("PSOPMPSR",$J,GROUP,STS)) Q:STS="" D
  1. . . I STS'="<NULL>" D
  1. . . . D GROUP^PSOPMP1($P(STS,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP,STS)),.LINE)
  1. . . F S SUB=$O(^TMP("PSOPMPSR",$J,GROUP,STS,SUB),$S(PSORDER="A":1,1:-1)) Q:SUB="" D
  1. . . . S Z=$G(^TMP("PSOPMPSR",$J,GROUP,STS,SUB))
  1. . . . S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3)
  1. . . . I GRP'["P" K ERXIEN1 S ORNUM1=$$GET1^DIQ(52,+Z,39.3,"I") D:ORNUM1 S X1=X1_$S($G(ERXIEN1):"& ",1:"")
  1. . . . . S ERXIEN1=$$CHKERX^PSOERXU1(ORNUM1)
  1. . . . S QTYL=$L($P(Z,"^",4)) S:QTYL<5 QTYL=5
  1. . . . 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))
  1. . . . 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)
  1. . . . . S ERXIEN1=$$CHKERX^PSOERXU1(ORNUM1)
  1. . . . I GRP["N" S $E(X1,49)="Date Documented:"
  1. . . . 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)
  1. . . . S $E(X1,66)=$P(Z,"^",7)
  1. . . . S $E(X1,74)=$J($P(Z,"^",8),3),$E(X1,78)=$J($P(Z,"^",9),3)
  1. . . . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X1,HIGHLN(LINE)=""
  1. . . . S IENSUB=$S(GRP["R"!(GRP["T")!(GRP["H"):"RX",GRP["P":"PEN",1:"NVA")
  1. . . . S ^TMP("PSOPMP0",$J,SEQ,IENSUB)=$P(Z,"^")
  1. . . . I IENSUB="PEN"&($P($G(^PS(52.41,+$P(Z,"^"),0)),"^",23)=1) S ^TMP("PSOPMP0",$J,LINE,"RV")=1
  1. . . . I $G(PSOSIGDP) D SETSIG^PSOPMP1($S(GRP["R"!(GRP["T")!(GRP["H"):"R",GRP["P":"P",1:"N"),+Z,.LINE,PSODFN)
  1. ;
  1. ;Saving NORMAL video attributes to be reset later
  1. I LINE>$G(LASTLINE) D
  1. . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
  1. . S LASTLINE=LINE
  1. D VIDEO^PSOPMP1()
  1. S VALMCNT=+$G(LINE) D RV^PSOPMP1
  1. Q
  1. ;
  1. SETSORT(FIELD) ;Sets the data sorted by the FIELD specified
  1. N SEQ,RX,RXNUM,DRUG,DRNAME,QTY,STATUS,STS,ISSDT,DOCDAT,LSTFD,REFREM,DAYSUP,SIG,Z,ORD,GRPCNT,GROUP,RFRX,OI,PSOBADR,RDREJ
  1. K ^TMP("PSOPMPSR",$J)
  1. ;Loading prescription (file #55)
  1. S SEQ=0
  1. F S SEQ=$O(^PS(55,PSODFN,"P",SEQ)) Q:'SEQ D
  1. . S RX=+$G(^PS(55,PSODFN,"P",SEQ,0)) I 'RX!($G(^PSRX(RX,0))="") Q
  1. . I $$FILTER^PSOPMP1(RX) Q
  1. . S RXNUM=$$GET1^DIQ(52,RX,.01)
  1. . S DRUG=$$GET1^DIQ(52,RX,6,"I")
  1. . S DRNAME=$$GET1^DIQ(50,DRUG,.01)
  1. . S QTY=$$GET1^DIQ(52,RX,7)
  1. . S STATUS=$$STSINFO^PSOPMP1(RX)
  1. . S ISSDT=$$ISSDT^PSOPMP1(RX,"R")
  1. . S LSTFD=$$LSTFD^PSOPMP1(RX)
  1. . S REFREM=$$REFREM^PSOPMP1(RX)
  1. . S DAYSUP=$$GET1^DIQ(52,RX,8)
  1. . S PSOBADR=$O(^PSRX(RX,"L",9999),-1)
  1. . I PSOBADR'="" S PSOBADR=$G(^PSRX(RX,"L",PSOBADR,0)) I PSOBADR["(BAD ADDRESS)" S PSOBADR="B"
  1. . I PSOBADR'="B" S PSOBADR=""
  1. . 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)
  1. . S $P(Z,"^",4)=QTY,$P(Z,"^",5)=$P(STATUS,"^",3)_$$CMOP^PSOPMP1(DRUG,RX)_PSOBADR,$P(Z,"^",6)=$P(ISSDT,"^",2)
  1. . S $P(Z,"^",7)=$P(LSTFD,"^",2),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP
  1. . S SORT=$S(FIELD="RX":RXNUM_" ",FIELD="DR":DRNAME_RXNUM,FIELD="ID":+ISSDT_RXNUM_" ",FIELD="LF":+LSTFD_RXNUM_" ")
  1. . S STS="<NULL>" I $G(PSOSTSGP) S STS=$P(STATUS,"^")_"^"_$P(STATUS,"^",2)
  1. . S GROUP=$P(PSORDSEQ("R"),"^")_"R^"_$P(PSORDSEQ("R"),"^",2)
  1. . ; PSO*427 changes for RRR/TRI/CVA reject display
  1. . S RDREJ=0 ; initialize RTS/DUR reject flag to 0
  1. . I $$FIND^PSOREJUT(RX,,,"79,88,943") S GROUP=$P(PSORDSEQ("T"),"^")_"T^"_$P(PSORDSEQ("T"),"^",2),STS="<NULL>",RDREJ=1
  1. . ; next look for any unresolved TRI/CVA rejects *427
  1. . I 'RDREJ,$$TRIC^PSOREJP1(RX),$$FIND^PSOREJUT(RX,,,,1) S GROUP=$P(PSORDSEQ("H"),U,1)_"H^"_$P(PSORDSEQ("H"),U,2),STS="<NULL>"
  1. . ; next look for any unresolved RRR rejects *427
  1. . I 'RDREJ,'$$TRIC^PSOREJP1(RX),$$FIND^PSOREJUT(RX,,,,,1) S GROUP=$P(PSORDSEQ("H"),U,1)_"H^"_$P(PSORDSEQ("H"),U,2),STS="<NULL>"
  1. . S ^TMP("PSOPMPSR",$J,GROUP,STS,SORT)=Z
  1. . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1,GRPCNT(GROUP,STS)=$G(GRPCNT(GROUP,STS))+1
  1. ;
  1. S GROUP=""
  1. F S GROUP=$O(GRPCNT(GROUP)) Q:GROUP="" D
  1. . S ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))
  1. . S STS="" F S STS=$O(GRPCNT(GROUP,STS)) Q:STS="" D
  1. . . S ^TMP("PSOPMPSR",$J,GROUP,STS)=GRPCNT(GROUP,STS)
  1. ;
  1. ;Loading pending orders (file #52.41)
  1. S ORD=0,GROUP=$P(PSORDSEQ("P"),"^")_"P^"_$P(PSORDSEQ("P"),"^",2)
  1. F S ORD=$O(^PS(52.41,"P",PSODFN,ORD)) Q:'ORD D
  1. . S TYPE=$$GET1^DIQ(52.41,ORD,2,"I")
  1. . I TYPE="DC"!(TYPE="DE")!(TYPE="HD") Q
  1. . S DRNAME="",DRUG=+$$GET1^DIQ(52.41,ORD,11,"I") I DRUG S DRNAME=$$GET1^DIQ(50,DRUG,.01)
  1. . I DRNAME="" D Q:DRNAME=""
  1. . . S OI=$$GET1^DIQ(52.41,ORD,8,"I") I 'OI Q
  1. . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)
  1. . S QTY=$$GET1^DIQ(52.41,ORD,12)
  1. . S STATUS=$$GET1^DIQ(52.41,ORD,2,"I")
  1. . S ISSDT=$$ISSDT^PSOPMP1(ORD,"P")
  1. . S REFREM=$$GET1^DIQ(52.41,ORD,13)
  1. . S DAYSUP=$$GET1^DIQ(52.41,ORD,101)
  1. . S RFRX="" I STATUS="RF" S RFRX=$$GET1^DIQ(52.41,ORD,21,"I") I RFRX S RFRX=$$GET1^DIQ(52,RFRX,.01)
  1. . 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)
  1. . S $P(Z,"^",6)=$S(RFRX'="":"Rx#: "_RFRX,1:$P(ISSDT,"^",2)),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP
  1. . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":+ISSDT_ORD,FIELD="LF":+ISSDT_ORD)
  1. . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z
  1. . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1
  1. S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))
  1. ;
  1. ;Loading Non-VA Med orders (file #55, sub-file #55.05)
  1. S ORD=0,GROUP=$P(PSORDSEQ("N"),"^")_"N^"_$P(PSORDSEQ("N"),"^",2)
  1. F S ORD=$O(^PS(55,PSODFN,"NVA",ORD)) Q:'ORD D
  1. . I $$GET1^DIQ(55.05,ORD_","_PSODFN,5,"I") Q
  1. . S DRNAME=$$GET1^DIQ(55.05,ORD_","_PSODFN,1)
  1. . I DRNAME="" D Q:DRNAME=""
  1. . . S OI=$$GET1^DIQ(55.05,ORD_","_PSODFN,.01,"I") I 'OI Q
  1. . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)
  1. . S DOCDAT=$P($$GET1^DIQ(55.05,ORD_","_PSODFN_",",11,"I"),".")
  1. . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,38),$P(Z,"^",7)=$$DAT^PSOPMP1(DOCDAT,"-")
  1. . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":DOCDAT_ORD,FIELD="LF":DOCDAT_ORD)
  1. . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z
  1. . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1
  1. ;
  1. S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))
  1. Q
  1. ;
  1. RX ;Sort by Rx
  1. D SORT("RX")
  1. Q
  1. DR ;Sort by Drug
  1. D SORT("DR")
  1. Q
  1. ID ;Sort by Issue Date
  1. D SORT("ID")
  1. Q
  1. LF ;Sort by Last Fill Date
  1. D SORT("LF")
  1. Q
  1. ;
  1. SORT(FIELD) ;Sort entries by FIELD
  1. I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A")
  1. E S PSOSRTBY=FIELD,PSORDER="A"
  1. D REF
  1. Q
  1. ;
  1. REF ;Screen Refresh
  1. W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"
  1. Q
  1. GS ;Group by Status
  1. W ?52,"Please wait..." S PSOSTSGP=$S($G(PSOSTSGP):0,1:1) D INIT,HDR S VALMBCK="R"
  1. Q
  1. SIG ;Display SIG
  1. W ?52,"Please wait..." S PSOSIGDP=$S($G(PSOSIGDP):0,1:1) D INIT,HDR S VALMBCK="R"
  1. I 'PSOSIGDP S VALMBG=VALMBG\2
  1. I PSOSIGDP S VALMBG=VALMBG*2-1
  1. S:VALMBG>(VALMCNT-10) VALMBG=VALMCNT-10 S:VALMBG<1 VALMBG=1
  1. Q
  1. PI ;Patient Information
  1. D EN^PSOLMPI S VALMBCK="R"
  1. Q
  1. CV ;Change View
  1. D LST^PSOPMPPF(SITE,DUZ) W !?52,"Please wait..." D INIT,HDR
  1. S VALMBG=1,VALMBCK="R"
  1. Q
  1. ;
  1. SEL ;Process selection of one entry
  1. N PSOSEL,TYPE,XQORM,ORD,TITLE,PSOLIS,XX
  1. S PSOLIS=$P(XQORNOD(0),"=",2) I 'PSOLIS S VALMSG="Invalid selection!",VALMBCK="R" Q
  1. F XX=1:1:$L(PSOLIS,",") Q:$P(PSOLIS,",",XX)']"" D
  1. .S PSOSEL=+$P(PSOLIS,",",XX) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
  1. .S TYPE=$O(^TMP("PSOPMP0",$J,PSOSEL,0)) I TYPE="" S VALMSG="Invalid selection!",VALMBCK="R" Q
  1. .S ORD=$G(^TMP("PSOPMP0",$J,PSOSEL,TYPE))
  1. .I 'ORD S VALMSG="Invalid selection!",VALMBCK="R" Q
  1. .S TITLE=VALM("TITLE")
  1. .;
  1. .;Regular prescription
  1. .I TYPE="RX" D S VALMBCK="R" D REF
  1. .. N PSOVDA,PSOSAVE,DA,PS
  1. .. S (PSOVDA,DA)=ORD,PS="REJECTMP"
  1. .. N LINE,TITLE,PSODFN D DP^PSORXVW
  1. .;
  1. .;Pending Order
  1. .I TYPE="PEN" D S VALMBCK="R" D REF
  1. .. N PSOACTOV,OR0
  1. .. S OR0=^PS(52.41,ORD,0),PSOACTOV=""
  1. .. N LINE,TITLE D PENHDR^PSOPMP1(PSODFN),DSPL^PSOORFI1
  1. .;
  1. .;Pending Order
  1. .I TYPE="NVA" D
  1. .. N LINE,TITLE D EN^PSONVAVW(PSODFN,ORD)
  1. .;
  1. S VALMBCK="R",VALM("TITLE")=TITLE
  1. Q
  1. ;
  1. EXIT ;
  1. K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J)
  1. Q
  1. ;
  1. HELP Q
  1. ;
  1. MEDPRO(RXIEN,FILL) ; MP Medication Profile
  1. ;
  1. ; This procedure relies on existing procedures which are part
  1. ; of Patient Medication Profile ListMan screen.
  1. ;
  1. ; New variables used in this procedure.
  1. ;
  1. N PSODFN,PSOSIGDP,PSOSITE,PSOSRTBY
  1. ;
  1. K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J)
  1. ;
  1. ; Determine Division IEN, ptr to file# 59, and Patient IEN.
  1. ;
  1. S PSOSITE=+$$RXSITE^PSOBPSUT(RXIEN,FILL)
  1. S PSODFN=+$$GET1^DIQ(52,RXIEN,2,"I")
  1. ;
  1. ; LOAD determines Division or User preferences.
  1. ;
  1. D LOAD^PSOPMPPF(PSOSITE,DUZ)
  1. S PSOSIGDP=0 ; Do not include signature info.
  1. ;
  1. ; SETSORT collects medication data into ^TMP("PSOPMPSR").
  1. ; SETLINE takes the data collected in ^TMP("PSOPMPSR") and
  1. ; creates the display lines in ^TMP("PSOPMP0").
  1. ;
  1. D SETSORT(PSOSRTBY)
  1. D SETLINE
  1. ;
  1. K ^TMP("PSOPMPSR",$J)
  1. ;
  1. ; Clean up variable set but neither Newed nor Killed in LOAD^PSOPMPPF.
  1. ;
  1. K PSOEXDCE,PSORDCNT,PSORDER,PSOSRTBY,PSOSTSEQ,PSOSTSGP
  1. ;
  1. Q