source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPMP1.m@ 636

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