- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPMP1.m
r613 r623 1 PSOPMP1 2 ;;7.0;OUTPATIENT PHARMACY;**260,285,281**;DEC 1997;Build 41 3 4 5 6 7 VIDEO() 8 9 10 11 12 13 14 15 16 17 18 19 . . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IORVOFF_IOINORM)20 21 22 23 SETHDR() 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 SETSIG(TYPE,RX,LINE,DFN) 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 GROUP(LBL,CNT,LINE) 55 56 57 58 59 60 61 62 PENHDR(DFN) 63 64 65 66 67 68 69 70 71 72 73 FILTER(RX) 74 75 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 176 77 78 79 80 STSINFO(RX) 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 ISSDT(IEN,TYPE) 99 100 101 102 103 104 105 106 107 108 LSTFD(RX) 109 110 111 112 113 114 115 116 117 118 119 120 REFREM(RX) 121 122 123 124 125 126 127 DAT(FMDT,SEP,Y4) 128 129 130 131 132 133 134 135 COPAY(RX) 136 137 138 CMOP(DRUG,RX) 139 140 141 142 143 144 ALLERGY(LINE,DFN,POS) 145 146 147 148 149 150 151 152 153 154 S ALLERGY=IORVON_ALLERGY_IORVOFF_IOINORM155 156 157 1 PSOPMP1 ;BIRM/MFR - Patient Medication Profile - Listmanager ;04/28/05 2 ;;7.0;OUTPATIENT PHARMACY;**260**;DEC 1997;Build 84 3 ;Reference to ^PSDRUG("AQ" supported by IA 3165 4 ;Reference to EN1^GMRADPT supported by IA 10099 5 ;Reference to ^PSXOPUTL supported by IA 2200 6 ; 7 VIDEO() ; - Changes the Video Attributes for the list 8 ; 9 ; - Highlighting the PRESCRIPTION line if SIG is displayed 10 I $G(PSOSIGDP) D 11 . F I=1:1:LINE D 12 . . I $D(HIGHLN(I)) D CNTRL^VALM10(I,1,80,IOINHI,IOINORM) 13 ; 14 ; - Highlighting the group lines (order type and status) 15 I $D(GRPLN) D 16 . S LN=0 F I=1:1 S LN=$O(GRPLN(LN)) Q:'LN D 17 . . S LBL=GRPLN(LN),POS=41-($L(LBL)\2) 18 . . D CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM) 19 . . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IOINORM) 20 . . D CNTRL^VALM10(LN,POS+$L(LBL),81-POS-$L(LBL),IOUON_IOINHI,IOINORM) 21 Q 22 ; 23 SETHDR() ; - Displays the Header Line 24 N HDR,ORD,POS 25 ; 26 ; - Line 1 27 S $E(HDR,57)="ISSUE",$E(HDR,66)="LAST",$E(HDR,74)="REF",$E(HDR,78)="DAY" 28 S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,6) 29 ; - Line 2 30 S HDR=" #",$E(HDR,5)="Rx#",$E(HDR,19)="DRUG",$E(HDR,49)="QTY",$E(HDR,53)="ST" 31 S $E(HDR,57)="DATE",$E(HDR,66)="FILL",$E(HDR,74)="REM",$E(HDR,78)="SUP" 32 S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,7) 33 S ORD=$S(PSORDER="A":"[^]",1:"[v]") 34 S:PSOSRTBY="RX" POS=9 S:PSOSRTBY="DR" POS=24 S:PSOSRTBY="ID" POS=61 S:PSOSRTBY="LF" POS=70 35 D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,7) 36 Q 37 ; 38 SETSIG(TYPE,RX,LINE,DFN) ; Set the SIG line 39 N FSIG,L,X,DIWL,DIWR 40 ; 41 I TYPE="N" D Q 42 . K ^UTILITY($J,"W") 43 . S X=$$SCHED^PSONVNEW($$GET1^DIQ(55.05,RX_","_DFN,4)),DIWL=1,DIWR=71 D ^DIWP 44 . F L=1:1 Q:'$D(^UTILITY($J,"W",1,L)) D 45 . . S X="" S:L=1 $E(X,5)="SIG:" S $E(X,10)=^UTILITY($J,"W",1,L,0) 46 . . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X 47 ; 48 D FSIG^PSOUTLA(TYPE,+RX,71) 49 F L=1:1 Q:'$D(FSIG(L)) D 50 . S X="" S:L=1 $E(X,5)="SIG:" S $E(X,10)=FSIG(L) 51 . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X 52 Q 53 ; 54 GROUP(LBL,CNT,LINE) ; Sets a group delimiter line 55 N X,POS 56 S LBL=LBL_$S(PSORDCNT:" ("_CNT_" order"_$S(CNT>1:"s",1:"")_")",1:"") 57 S POS=41-($L(LBL)\2) 58 S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL 59 S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X,GRPLN(LINE)=LBL 60 Q 61 ; 62 PENHDR(DFN) ; Sets the Header in the ^TMP("PSOHDR",$J) global for displaying individual Pending Order 63 N VADM,WT,HT,PSOERR,GMRA 64 K ^TMP("PSOHDR",$J) D ^VADPT,ADD^VADPT 65 S ^TMP("PSOHDR",$J,1,0)=VADM(1),^TMP("PSOHDR",$J,2,0)=$P(VADM(2),"^",2) 66 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) 67 S POERR=1 D RE^PSODEM K PSOERR 68 S ^TMP("PSOHDR",$J,6,0)=$S(+$P(WT,"^",8):$J($P(WT,"^",9),6)_" ("_$P(WT,"^")_")",1:"_______ (______)") 69 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 70 S GMRA="0^0^111" D EN1^GMRADPT S ^TMP("PSOHDR",$J,8,0)=+$G(GMRAL) 71 Q 72 ; 73 FILTER(RX) ; - Filter Rx's that should not be displayed 74 I $$GET1^DIQ(52,RX,26,"I")<PSOEXPDC Q 1 75 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 76 I $$GET1^DIQ(52,RX,100,"I")=""!($$GET1^DIQ(52,RX,100,"I")=13) Q 1 77 I $$GET1^DIQ(52,RX,.01)="" Q 1 78 Q 0 79 ; 80 STSINFO(RX) ; Returns the Rx Status MNEMONIC^NAME 81 ; Input: RX - Prescription IEN (#52) 82 ;Output: Status Mnemonic ("A","DC",etc.)^Status Name ("ACTIVE","DISCONTINUED",etc.) 83 ; 84 N STS 85 I '$D(^PSRX(RX,"STA")) Q "" 86 S STS=$$GET1^DIQ(52,RX,100,"I") 87 I STS=0 Q:$$GET1^DIQ(52,RX,26,"I")>DT PSOSTSEQ("A") Q PSOSTSEQ("E") 88 I STS=1 Q PSOSTSEQ("N") 89 I STS=3 Q PSOSTSEQ("H") 90 I STS=5 Q PSOSTSEQ("S") 91 I STS=11 Q PSOSTSEQ("E") 92 I STS=12 Q PSOSTSEQ("DC") 93 I STS=14 Q PSOSTSEQ("DP") 94 I STS=15 Q PSOSTSEQ("DE") 95 I STS=16 Q PSOSTSEQ("PH") 96 Q "99^UNKNOWN^??" 97 ; 98 ISSDT(IEN,TYPE) ; Returns the Rx ISSUE DATE formatted MM-DD-YY 99 ;Input: RX - PrescrXiption IEN (#52) 100 ; TYPE - "R":Regular Rx, "P":Pending order 101 N ISSDT 102 I TYPE="R" S ISSDT=$$GET1^DIQ(52,IEN,1,"I") 103 I TYPE="P" S ISSDT=$$GET1^DIQ(52.41,IEN,6,"I") 104 I ISSDT'="" S ISSDT=ISSDT\1 105 ; 106 Q (ISSDT_"^"_$$DAT(ISSDT,"-")) 107 ; 108 LSTFD(RX) ; Returns the Rx LAST FILL DATE formatted MM-DD-YY[R], where [R] = Returned to Stock 109 ;Input: RX - Prescription IEN (#52) 110 N LSTFD,RTSTK,RFL 111 S LSTFD=$$GET1^DIQ(52,RX,101,"I")\1 I LSTFD="" Q "" 112 I '$$LSTRFL^PSOBPSU1(RX) D 113 . I $$GET1^DIQ(52,RX,32.1,"I") S RTSTK="R" 114 E S RFL=0 F S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL D 115 . I $$RXFLDT^PSOBPSUT(RX,RFL)'=LSTFD Q 116 . I $$GET1^DIQ(52.1,RFL_","_RX,14,"I") S RTSTK="R" 117 ; 118 Q (LSTFD_"^"_$$DAT(LSTFD,"-")_$G(RTSTK)) 119 ; 120 REFREM(RX) ; - Returns the number of refills remaining 121 N REFREM,RFL 122 S REFREM=+$$GET1^DIQ(52,RX,9) 123 F RFL=0:1 S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL S REFREM=REFREM-1 124 Q $S(REFREM<0:0,1:REFREM) 125 ; 126 ; 127 DAT(FMDT,SEP,Y4) ; - Formats FM dates to MM/DD/YY (SEP: Separator:"/","-",etc...) 128 ;Input: (r) FMDT - Fileman Date 129 ; (r) SEP - Separator 130 ; (o) Y4 - 4 digits year flag 131 I $G(FMDT)="" Q "" 132 I '$E(FMDT,6,7)!'$E(FMDT,4,7) Q $$UP^XLFSTR($TR($$FMTE^XLFDT(FMDT)," ","-")) 133 Q ($E(FMDT,4,5)_SEP_$E(FMDT,6,7)_SEP_$S($G(Y4):$E(FMDT,1,3)+1700,1:$E(FMDT,2,3))) 134 ; 135 COPAY(RX) ; Returns "$" is Rx has a copay and "" if not 136 Q $S($D(^PSRX(RX,"IB")):"$",1:"") 137 ; 138 CMOP(DRUG,RX) ; Returns the CMOP indicator (">", "T", etc) 139 N CMOP,X,DA,PSXZ 140 S CMOP="" I $D(^PSDRUG("AQ",DRUG)) S CMOP=">" 141 I $G(RX) S DA=RX D ^PSXOPUTL I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S CMOP="T" 142 Q CMOP 143 ; 144 ALLERGY(LINE,DFN,POS) ; also called from PSONVAVW & PSOPMP0 145 ; Input: LINE - (r) text to concatenate allergy information to 146 ; DFN - (r) patient IEN used for ^GMRADTP 147 ; POS - (o) position # to include text 148 ;Output: LINE - modified text 149 N ALLERGY,PSONOAL 150 S (PSONOAL,ALLERGY)="" 151 D EN1^GMRADPT 152 I GMRAL S ALLERGY="<A>" 153 E D ALLERGY^PSOORUT2 I PSONOAL'="" S ALLERGY="<NO ALLERGY ASSESSMENT>" 154 S ALLERGY=IORVON_ALLERGY_IOINORM 155 I '$G(POS) S POS=80-$L(ALLERGY) 156 S LINE=$$SETSTR^VALM1(ALLERGY,LINE,POS,80) 157 Q LINE
Note:
See TracChangeset
for help on using the changeset viewer.
