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

PSOPMP1.m

Go to the documentation of this file. 
  1. PSOPMP1 ;BIRM/MFR - Patient Medication Profile - Listmanager ;04/28/05
  1.  ;;7.0;OUTPATIENT PHARMACY;**260,285,281,303,289**;DEC 1997;Build 107
  1.  ;Reference to ^PSDRUG("AQ" supported by IA 3165
  1.  ;Reference to EN1^GMRADPT supported by IA 10099
  1.  ;Reference to ^PSXOPUTL supported by IA 2200
  1.  ;
  1. VIDEO() ; - Changes the Video Attributes for the list
  1.  ;
  1.  ; - Highlighting the PRESCRIPTION line if SIG is displayed
  1.  I $G(PSOSIGDP) D
  1.  . F I=1:1:LINE D
  1.  . . I $D(HIGHLN(I)) D CNTRL^VALM10(I,1,80,IOINHI,IOINORM)
  1.  ;
  1.  ; - Highlighting the group lines (order type and status)
  1.  I $D(GRPLN) D
  1.  . S LN=0 F I=1:1 S LN=$O(GRPLN(LN)) Q:'LN  D
  1.  . . S LBL=GRPLN(LN),POS=41-($L(LBL)\2)
  1.  . . D CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
  1.  . . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
  1.  . . D CNTRL^VALM10(LN,POS+$L(LBL),81-POS-$L(LBL),IOUON_IOINHI,IOINORM)
  1.  Q
  1.  ;
  1. RV ;reverse video for flagged pending orders
  1.  N PSLIST S PSLIST=0 F PSLIST=1:1:VALMCNT D
  1.  .Q:'$D(^TMP("PSOPMP0",$J,PSLIST,"RV"))
  1.  .I $D(^TMP("PSOPMP0",$J,PSLIST,"RV")) D CNTRL^VALM10(PSLIST,1,3,IORVON,IORVOFF,0) Q
  1.  Q
  1.  ;
  1. SETHDR() ; - Displays the Header Line
  1.  N HDR,ORD,POS
  1.  ;
  1.  ; - Line 1
  1.  S $E(HDR,57)="ISSUE",$E(HDR,66)="LAST",$E(HDR,74)="REF",$E(HDR,78)="DAY"
  1.  S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,6)
  1.  ; - Line 2
  1.  S HDR="  #",$E(HDR,5)="Rx#",$E(HDR,19)="DRUG",$E(HDR,49)="QTY",$E(HDR,53)="ST"
  1.  S $E(HDR,57)="DATE",$E(HDR,66)="FILL",$E(HDR,74)="REM",$E(HDR,78)="SUP"
  1.  S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,7)
  1.  S ORD=$S(PSORDER="A":"[^]",1:"[v]")
  1.  S:PSOSRTBY="RX" POS=9 S:PSOSRTBY="DR" POS=24 S:PSOSRTBY="ID" POS=61 S:PSOSRTBY="LF" POS=70
  1.  D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,7)
  1.  Q
  1.  ;
  1. SETSIG(TYPE,RX,LINE,DFN) ; Set the SIG line
  1.  N FSIG,L,X,DIWL,DIWR
  1.  ;
  1.  I TYPE="N" D  Q
  1.  . K ^UTILITY($J,"W")
  1.  . S X=$$SCHED^PSONVNEW($$GET1^DIQ(55.05,RX_","_DFN,4)),DIWL=1,DIWR=71 D ^DIWP
  1.  . F L=1:1 Q:'$D(^UTILITY($J,"W",1,L))  D
  1.  . . S X="" S:L=1 $E(X,5)="SIG:" S $E(X,10)=^UTILITY($J,"W",1,L,0)
  1.  . . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X
  1.  ;
  1.  D FSIG^PSOUTLA(TYPE,+RX,71)
  1.  F L=1:1 Q:'$D(FSIG(L))  D
  1.  . S X="" S:L=1 $E(X,5)="SIG:" S $E(X,10)=FSIG(L)
  1.  . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X
  1.  Q
  1.  ;
  1. GROUP(LBL,CNT,LINE) ; Sets a group delimiter line
  1.  N X,POS
  1.  S LBL=LBL_$S(PSORDCNT:" ("_CNT_" order"_$S(CNT>1:"s",1:"")_")",1:"")
  1.  S POS=41-($L(LBL)\2)
  1.  S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
  1.  S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X,GRPLN(LINE)=LBL
  1.  Q
  1.  ;
  1. PENHDR(DFN) ; Sets the Header in the ^TMP("PSOHDR",$J) global for displaying individual Pending Order
  1.  N VADM,WT,HT,PSOERR,GMRA
  1.  K ^TMP("PSOHDR",$J) D ^VADPT,ADD^VADPT
  1.  S ^TMP("PSOHDR",$J,1,0)=VADM(1),^TMP("PSOHDR",$J,2,0)=$P(VADM(2),"^",2)
  1.  S ^TMP("PSOHDR",$J,3,0)=$P(VADM(3),"^",2),^TMP("PSOHDR",$J,4,0)=VADM(4),^TMP("PSOHDR",$J,5,0)=$P(VADM(5),"^",2)
  1.  S POERR=1 D RE^PSODEM K PSOERR
  1.  S ^TMP("PSOHDR",$J,6,0)=$S(+$P(WT,"^",8):$J($P(WT,"^",9),6)_" ("_$P(WT,"^")_")",1:"_______ (______)")
  1.  S ^TMP("PSOHDR",$J,7,0)=$S($P(HT,"^",8):$J($P(HT,"^",9),6)_" ("_$P(HT,"^")_")",1:"_______ (______)") K VM,WT,HT S PSOHD=7
  1.  S GMRA="0^0^111" D EN1^GMRADPT S ^TMP("PSOHDR",$J,8,0)=+$G(GMRAL)
  1.  Q
  1.  ;
  1. FILTER(RX) ; - Filter Rx's that should not be displayed
  1.  I $$GET1^DIQ(52,RX,26,"I")<PSOEXPDC Q 1
  1.  I $$GET1^DIQ(52,RX,26.1,"I"),$$GET1^DIQ(52,RX,26.1,"I")<PSOEXPDC,$$GET1^DIQ(52,RX,100,"I")>11,$$GET1^DIQ(52,RX,100,"I")'=16 Q 1
  1.  I $$GET1^DIQ(52,RX,100,"I")=""!($$GET1^DIQ(52,RX,100,"I")=13) Q 1
  1.  I $$GET1^DIQ(52,RX,.01)="" Q 1
  1.  Q 0
  1.  ;
  1. STSINFO(RX) ; Returns the Rx Status MNEMONIC^NAME
  1.  ; Input: RX - Prescription IEN (#52)
  1.  ;Output: Status Mnemonic ("A","DC",etc.)^Status Name ("ACTIVE","DISCONTINUED",etc.)
  1.  ;
  1.  N STS
  1.  I '$D(^PSRX(RX,"STA")) Q ""
  1.  S STS=$$GET1^DIQ(52,RX,100,"I")
  1.  I STS=0 Q:$$GET1^DIQ(52,RX,26,"I")>DT PSOSTSEQ("A") Q PSOSTSEQ("E")
  1.  I STS=1 Q PSOSTSEQ("N")
  1.  I STS=3 Q PSOSTSEQ("H")
  1.  I STS=5 Q PSOSTSEQ("S")
  1.  I STS=11 Q PSOSTSEQ("E")
  1.  I STS=12 Q PSOSTSEQ("DC")
  1.  I STS=14 Q PSOSTSEQ("DP")
  1.  I STS=15 Q PSOSTSEQ("DE")
  1.  I STS=16 Q PSOSTSEQ("PH")
  1.  Q "99^UNKNOWN^??"
  1.  ; 
  1. ISSDT(IEN,TYPE) ; Returns the Rx ISSUE DATE formatted MM-DD-YY
  1.  ;Input: RX   - Prescription IEN (#52)
  1.  ;       TYPE - "R":Regular Rx, "P":Pending order
  1.  N ISSDT
  1.  I TYPE="R" S ISSDT=$$GET1^DIQ(52,IEN,1,"I")
  1.  I TYPE="P" S ISSDT=$$GET1^DIQ(52.41,IEN,6,"I")
  1.  I ISSDT'="" S ISSDT=ISSDT\1
  1.  ;
  1.  Q (ISSDT_"^"_$$DAT(ISSDT,"-"))
  1.  ;
  1. LSTFD(RX) ; Returns the Rx LAST FILL DATE formatted MM-DD-YY[R], where [R] = Returned to Stock
  1.  ;Input: RX  - Prescription IEN (#52)
  1.  N LSTFD,RTSTK,RFL
  1.  S LSTFD=$$GET1^DIQ(52,RX,101,"I")\1 I LSTFD="" Q ""
  1.  I '$$LSTRFL^PSOBPSU1(RX) D
  1.  . I $$GET1^DIQ(52,RX,32.1,"I") S RTSTK="R"
  1.  E  S RFL=0 F  S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL  D
  1.  . I $$RXFLDT^PSOBPSUT(RX,RFL)'=LSTFD Q
  1.  . I $$GET1^DIQ(52.1,RFL_","_RX,14,"I") S RTSTK="R"
  1.  ;
  1.  Q (LSTFD_"^"_$$DAT(LSTFD,"-")_$G(RTSTK))
  1.  ;
  1. REFREM(RX) ; - Returns the number of refills remaining
  1.  N REFREM,RFL
  1.  S REFREM=+$$GET1^DIQ(52,RX,9)
  1.  F RFL=0:1 S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL  S REFREM=REFREM-1
  1.  Q $S(REFREM<0:0,1:REFREM)
  1.  ;
  1.  ;
  1. DAT(FMDT,SEP,Y4) ; - Formats FM dates to MM/DD/YY (SEP: Separator:"/","-",etc...)
  1.  ;Input: (r) FMDT - Fileman Date
  1.  ;       (r) SEP  - Separator
  1.  ;       (o) Y4   - 4 digits year flag
  1.  I $G(FMDT)="" Q ""
  1.  I '$E(FMDT,6,7)!'$E(FMDT,4,7) Q $$UP^XLFSTR($TR($$FMTE^XLFDT(FMDT)," ","-"))
  1.  Q ($E(FMDT,4,5)_SEP_$E(FMDT,6,7)_SEP_$S($G(Y4):$E(FMDT,1,3)+1700,1:$E(FMDT,2,3)))
  1.  ;
  1. COPAY(RX) ; Returns "$" is Rx has a copay and "" if not
  1.  Q $S($D(^PSRX(RX,"IB")):"$",1:"")
  1.  ;
  1. CMOP(DRUG,RX) ; Returns the CMOP indicator (">", "T", etc)
  1.  N CMOP,X,DA,PSXZ
  1.  S CMOP="" I $D(^PSDRUG("AQ",DRUG)) S CMOP=">"
  1.  I $G(RX) S DA=RX D ^PSXOPUTL I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S CMOP="T"
  1.  Q CMOP
  1.  ;
  1. ALLERGY(LINE,DFN,POS) ; also called from PSONVAVW & PSOPMP0
  1.  ; Input:  LINE - (r) text to concatenate allergy information to
  1.  ;         DFN - (r) patient IEN used for ^GMRADTP
  1.  ;         POS - (o) position # to include text
  1.  ;Output: LINE - modified text
  1.  N ALLERGY,PSONOAL
  1.  S (PSONOAL,ALLERGY)=""
  1.  D EN1^GMRADPT
  1.  I GMRAL S ALLERGY="<A>"
  1.  E  D ALLERGY^PSOORUT2 I PSONOAL'="" S ALLERGY="<NO ALLERGY ASSESSMENT>"
  1.  S ALLERGY=IORVON_ALLERGY_IORVOFF_IOINORM
  1.  I '$G(POS) S POS=80-$L(ALLERGY)
  1.  S LINE=$$SETSTR^VALM1(ALLERGY,LINE,POS,80)
  1.  Q LINE