Changeset 623 for WorldVistAEHR/trunk/r/CMOP-PSX/PSXBLD1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CMOP-PSX/PSXBLD1.m
r613 r623 1 PSXBLD1 2 ;;2.0;CMOP;**3,18,19,42,41,49,57,64**;11 Apr 97;Build 1 3 4 5 6 7 8 9 MRX 10 11 12 BUILD 13 14 15 16 SCRNEW 17 18 19 20 21 S1 22 23 24 25 26 27 28 REFILL 29 30 31 RZX 32 33 SUS 34 35 36 37 38 39 40 41 42 43 44 45 46 S2 47 48 49 50 51 52 DIV 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 ORD 75 76 77 78 79 80 81 82 WARN 83 84 85 86 87 88 89 90 S TXT(3)="Lines beyond seven are not being sent to the CMOP."91 92 93 94 95 96 97 98 SET 99 100 101 102 103 1 PSXBLD1 ;BIR/BAB,HTW,WPB-Document Data for Transmission ;10/15/98 10:38 AM 2 ;;2.0;CMOP;**3,18,19,42,41,49,57**;11 Apr 97 3 ;Reference to ^PSRX( supported by DBIA #1977 4 ;Reference to ^PSDRUG( supported by DBIA #1983 5 ;Reference to ^PS(55, supported by DBIA #2228 6 ;Reference to ^PS(59.7, supported by DBIA #694 7 ;Reference to ^PS(59, supported by DBIA #1976 8 ;Reference to PROD2^PSNAPIS supported by DBIA #2531 9 MRX ;Multi rx 10 G:'$P(PSOPAR,"^",18) SUS 11 F ZZ=0:0 S ZZ=$O(^PS(55,DFN,"P",ZZ)) Q:'ZZ S NBR=0 D RZX 12 BUILD ; 13 F PSA=0:0 S PSA=$O(RX(PSA)) Q:'PSA D SCRNEW 14 K NAME,REFILL,PSDT2,NBR,PSRX,PSA,TN,AMC,PSRFL,X1,X2,PSRXX,RXNUM,ZZ 15 G SUS 16 SCRNEW ; 17 S IEN50=+$P(^PSRX(PSA,0),U,6),NAME=$P(^PSDRUG(IEN50,0),U) 18 I '$D(^PSDRUG(IEN50,"ND")) G S1 19 S IENDF=$P($G(^PSDRUG(IEN50,"ND")),U),ZD1=$P($G(^("ND")),U,3) 20 I $G(IENDF),($G(ZD1)) S ZX=$$PROD2^PSNAPIS(IENDF,ZD1),ZNDF=$P($G(ZX),"^") 21 S1 S ZPRT=$S($G(ZNDF):ZNDF,1:NAME) K ZNDF,IENDF,NAME,IEN50,ZD1 22 S ZPRT=$E(ZPRT,1,30) 23 S REFILL=$P(RX(PSA),"^",2) 24 S PSDT2=$P(RX(PSA),"^",1),PSDT2=PSDT2+17000000 25 S RXNUM=$P($G(^PSRX(PSA,0)),"^") 26 S NBR=NBR+1,PSXORD("M",NBR)="NTE|5||"_RXNUM_"\F\"_ZPRT_"\F\"_REFILL_"\F\"_PSDT2_$S($P(PSOPAR,"^",19):"\F\"_PSOINST_"-"_PSA,1:"") 27 Q 28 REFILL F AMC=0:0 S AMC=$O(^PSRX(PSRXX,1,AMC)) Q:'AMC S PSRFL=PSRFL-1 29 I PSRFL>0 S X1=DT,X2=$P(^PSRX(PSRXX,0),"^",8)-10 D C^%DTC I X'<$P(^(2),"^",6) S PSRFL=0 30 Q 31 RZX S PSRXX=+^PS(55,DFN,"P",ZZ,0) I $D(^PSRX(PSRXX,0)) S PSRFL=$P(^(0),"^",9) D:$D(^(1))&PSRFL REFILL I PSRFL>0,$P(^PSRX(PSRXX,"STA"),"^",1)<10,13456'[$E($P(^("STA"),"^",1)),$P(^(2),"^",6)>DT S RX(PSRXX)=$P(^(2),"^",6)_"^"_PSRFL 32 Q 33 SUS ;Susp Notif-(PSXDTRG-last date transmitted) 34 Q:'$G(DFN)!('$G(PSXDTRG)) 35 S CT=1 36 F I=PSXDTRG:0 S I=$O(^PS(55,DFN,"P","A",I)) Q:'I D 37 .F J=0:0 S J=$O(^PS(55,DFN,"P","A",I,J)) Q:'J S JJ=J D:$D(JJ) S CT=CT+1 38 ..S NODE=$G(^PSRX(JJ,0)) Q:NODE']"" 39 ..S STATUS=+$P(^PSRX(JJ,"STA"),"^",1) Q:STATUS'=5!(STATUS>10) 40 ..Q:$D(^PSX(550.2,PSXBAT,15,"B",JJ)) ;built in PSXRPPL PSX*2*42 41 ..S ERX=$P(NODE,U) 42 ..S IEN50=$P(NODE,"^",6),NAME=$P(^PSDRUG(IEN50,0),U) 43 ..I '$D(^PSDRUG(IEN50,"ND")) G S2 44 ..S IENDF=$P($G(^PSDRUG(IEN50,"ND")),U),ZD1=$P($G(^("ND")),U,3) 45 ..I $G(IENDF),($G(ZD1)) S ZX=$$PROD2^PSNAPIS(IENDF,ZD1),ZNDF=$P($G(ZX),"^") 46 S2 ..S ZPRT=$S($G(ZNDF):ZNDF,1:NAME) 47 ..S ZPRT=$E(ZPRT,1,30) 48 ..S PSXORD("E",CT)="NTE|6||"_ERX_"\F\"_ZPRT 49 ..K NODE,STATUS,ERX,IEN50,IENDF,ZD1,ZNDF,ZPRT,NAME,ZX 50 K I,J,NODE,STATUS,JJ,ZPRT,NAME,IENDF,IEN50,CT,RX 51 Q 52 DIV ;NTE|1||Site #\S\Div Name\S\Facility #\F\Street Add 1\S\Street Add 2\S\City\S\State Abbrev\S\Zip Code\F\Area Code & Phone # 53 S PSXERFLG=0,PSXER=3 54 S TNODE=$G(^PS(59,PSOSITE,0)) 55 ;Set site address to refill div if selected in system parameters 56 I $P($G(^PS(59.7,1,40.1)),"^",4) S REFDIV=$P(^(40.1),"^",4) D 57 .S TNODE1=$G(^PS(59,REFDIV,0)),TNODE=TNODE1 K TNODE1 58 S PSXFAC=$P($G(PSXSYS),U,2) 59 S STATE=$P(TNODE,"^",8),SITE=$P(TNODE,U,6) S (TEMP,Y)=TNODE 60 S:STATE="" PSXER=PSXER_"^"_1,PSXERFLG=1 61 S:SITE="" PSXER=PSXER_"^"_2,PSXERFLG=1 62 S:$P(TNODE,U,1)="" PSXER=PSXER_"^"_3,PSXERFLG=1 63 S:$P(TNODE,U,2)="" PSXER=PSXER_"^"_4,PSXERFLG=1 64 S:$P(TNODE,U,7)="" PSXER=PSXER_"^"_5,PSXERFLG=1 65 S:$P(TNODE,U,5)="" PSXER=PSXER_"^"_6,PSXERFLG=1 66 S:$P(TNODE,U,3)="" PSXER=PSXER_"^"_7,PSXERFLG=1 67 S:$P(TNODE,U,4)="" PSXER=PSXER_"^"_8,PSXERFLG=1 68 ;VMP OIFO BAY PINES;ELR;PSX*2*57 SET PSXERFLG=0 NEXT LINE AND LINE AFTER THAT 69 I PSXERFLG=1 D ER1^PSXERR S PSXERFLG=0,PSXDIVER=1 Q 70 Q:$G(PSXPRECK)=1 71 S SZIP=$P(TNODE,U,5) I $L(SZIP)>5 S SZIP=$E(SZIP,1,5)_"-"_$E(SZIP,6,9) 72 S PSXORD("A")="NTE|1||"_SITE_"\S\"_$P(TNODE,U,1)_"\S\"_PSXFAC_"\F\"_$P(TNODE,U,2)_"\S\\S\"_$P(TNODE,U,7)_"\S\"_$P(^DIC(5,STATE,0),U,2)_"\S\"_SZIP_"\F\"_"("_$P(TNODE,U,3)_") "_$P(TNODE,U,4) 73 K SZIP 74 ORD ; 75 S DIWL=1,DIWR=45,DIWF="C45" 76 F NODE=6,7,4 K ^UTILITY($J,"W") S (RECL,REC)=0 F S REC=$O(^PS(59,PSOSITE,NODE,REC)) Q:REC'>0 S X=^(REC,0),NODE=NODE D 77 . I REC'>7 S Y=X D STRIP^PSXBLD S X=Y D ^DIWP,SET I 1 78 . E S WARN(NODE)=REC 79 D:$D(WARN) WARN 80 K DIWF,DIWL,DIWR,I,NODE,STATE,SITE,TNODE,NUM,REC,Y,Y,X,Z,^UTILITY($J,"W") 81 Q 82 WARN ;send msg 83 S XMSUB=">>WARNING<< CMOP Pharmacy Site Prescription Instructions" 84 ;N TXT,XT 85 S XT(6)="NARRATIVE REFILLABLE RX" 86 S XT(7)="NARRATIVE NON REFILLABLE RX" 87 S XT(4)="NARRATIVE FOR COPAY DOCUMENT" 88 S TXT(1)="The following Pharmacy Site instruction(s) exceed seven lines." 89 S TXT(2)="This exceeds CMOP limits." 90 S TXT(3)="Lines beyound seven are not being sent to the CMOP." 91 S TXT(4)=" ",TXT(5)="Pharmacy Site: "_$$GET1^DIQ(59,PSOSITE,.01),L=5 92 F NODE=6,7,4 I $DATA(WARN(NODE)) S L=L+1,TXT(L)=XT(NODE)_" "_WARN(NODE)_" lines" 93 S XMTEXT="TXT(" 94 D GRP1^PSXNOTE 95 S XMY(DUZ)="" 96 D ^XMD 97 Q 98 SET ; 99 K PSXORDD S NUM=0 100 F S NUM=$O(^UTILITY($J,"W",1,NUM)) Q:NUM'>0 S PSXORDD(NUM)=$G(^UTILITY($J,"W",1,NUM,0)) S PSXORDD(NUM)=$S(NODE=4:"NTE|4||"_PSXORDD(NUM),NODE=6:"NTE|2||"_PSXORDD(NUM),NODE=7:"NTE|3||"_PSXORDD(NUM),1:0) 101 ;F CNT=1:2 S CNT=$O(PSXORDD(CNT)) Q:CNT="" S XX=$L(PSXORDD(CNT)),PSXORDD(CNT-1)=PSXORDD(CNT-1)_"\R\"_$E(PSXORDD(CNT),8,XX) K PSXORDD(CNT) 102 S %X="PSXORDD(",%Y=$S(NODE=4:"PSXORD(""D"",",NODE=6:"PSXORD(""B"",",NODE=7:"PSXORD(""C"",",1:0) D %XY^%RCR K %X,%Y,TEMP 103 Q
Note:
See TracChangeset
for help on using the changeset viewer.