- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSJORDF.m
r613 r623 1 PSSJORDF ;BIR/MV-RETURN MED ROUTES(MR) AND INSTRUCTIONS(INS) ;06/26/98 2 ;;1.0;PHARMACY DATA MANAGEMENT;**5,13,34,38,69,113,94**;9/30/97;Build 26 3 ;; 4 ; Reference to ^PS(50.7 is supported by DBIA 2180. 5 ; Reference to ^PS(51.2 is supported by DBIA 2178. 6 ; Reference to ^PS(50.606 is supported by DBIA 2174. 7 ; 8 ;* PSJORD is the Orderable Item IEN pass to Pharmacy by OE/RR. 9 ;* 1. If the dosage form is valid, this routine will return all med 10 ;* routes and instructions associated with that dose form. 11 ;* 2. If the dose form is null, this routine will return all med routes 12 ;* that exist in the medication routes file. 13 ;* 3. ^TMP format: 14 ;* ^TMP("PSJMR",$J,#)=MED ROUTE^MED ROUTE ABREVATION^IEN^OUTPATIENT 15 ;* EXPANSION^IV FLAG^DEFAULT FLAG 16 ;* ^TMP("PSJNOUN",$J,D0)=NOUN^VERB^PREPOSITION 17 ;* ^TMP("PSJSCH",$J)=DEFAULT SCHEDULE NAME 18 ; 19 START(PSJORD,PSJOPAC) ; 20 NEW MR,MRNODE,INS,PSJDFNO,X,MCT,Z,PSJOISC 21 I '+PSJORD D MEDROUTE Q 22 S PSJDFNO=+$P($G(^PS(50.7,+PSJORD,0)),U,2) 23 ;S ^TMP("PSJSCH",$J)=$P($G(^PS(50.7,+PSJORD,0)),"^",8) ;default schedule 24 S PSJOISC=$P($G(^PS(50.7,+PSJORD,0)),"^",8) 25 I $G(PSJOPAC)="O"!($G(PSJOPAC)="X") D:$G(PSJOISC)'="" EN^PSSOUTSC(.PSJOISC) S:$G(PSJOISC)'="" ^TMP("PSJSCH",$J)=$G(PSJOISC) G SCPASS 26 I $G(PSJOISC)'="" D EN^PSSGSGUI(.PSJOISC,"I") S:$G(PSJOISC)'="" ^TMP("PSJSCH",$J)=$G(PSJOISC) 27 SCPASS ; 28 I $G(^PS(50.606,PSJDFNO,0))="" D NOD Q:$D(^TMP("PSJMR",$J,1)) D MEDROUTE Q 29 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J) 30 D DF 31 Q 32 ; 33 DF ;* Loop thru DF node to find all available med routes, nouns, and instructions. 34 N VERB,MR,INS,X 35 S (MR,INS,X,MCT)=0 36 S VERB=$P($G(^PS(50.606,PSJDFNO,"MISC")),U) 37 S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P($G(^(0)),"^",4)=1 S ^TMP("PSJMR",$J,1)=$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_MR_U_$P(^(0),"^",2)_U_$S($P(^(0),"^",6):1,1:0)_"^D",MCT=MCT+1 38 S MR=0 F S MR=$O(^PS(50.606,PSJDFNO,"MR",MR)) Q:'MR D 39 . S X=+$G(^PS(50.606,PSJDFNO,"MR",MR,0)) Q:'X!($P($G(^TMP("PSJMR",$J,1)),"^",3)=X) 40 . S MRNODE=$G(^PS(51.2,X,0)) 41 . I $P($G(MRNODE),"^",4)'=1 Q 42 . S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_X_U_$P(MRNODE,U,2)_U_$S($P(MRNODE,U,6):1,1:0) 43 S X=0 44 ;F S INS=$O(^PS(50.606,PSJDFNO,"INS",INS)) Q:'INS S X=X+1,^TMP("PSJINS",$J,X)=VERB_U_$G(^PS(50.606,PSJDFNO,"INS",INS,0)) 45 ;I '$D(^TMP("PSJINS",$J)),VERB]"" S ^TMP("PSJINS",$J,1)=VERB 46 S X=0 47 I $D(^PS(50.606,PSJDFNO,"NOUN")) F Z=0:0 S Z=$O(^PS(50.606,PSJDFNO,"NOUN",Z)) Q:'Z S X=X+1,^TMP("PSJNOUN",$J,X)=$P($G(^PS(50.606,PSJDFNO,"NOUN",Z,0)),U)_U_$P($G(^PS(50.606,PSJDFNO,"MISC")),U)_U_$P($G(^("MISC")),U,3) 48 Q 49 ; 50 MEDROUTE ;* Return all med routes in the med routes file. 51 S (MR,MCT)=0 K ^TMP("PSJMR",$J) 52 F S MR=$O(^PS(51.2,MR)) Q:'MR S MRNODE=^PS(51.2,MR,0) I $P(^PS(51.2,MR,0),"^",4)=1 S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_MR_U_$P(MRNODE,U,2)_U_$S($P(MRNODE,U,6):1,1:0) 53 Q 54 NOD K ^TMP("PSJMR",$J) 55 S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P(^PS(51.2,MR,0),"^",4)=1 S ^TMP("PSJMR",$J,1)=$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_MR_U_$P(^(0),"^",2)_U_$S($P(^(0),"^",6):1,1:0)_"^D" 56 Q 57 START1(PSJORD,PSJQOF) ;Entry point for IV dialog PSS*1*94 58 ; This is the new entry point for the IV Dialog box from CPRS GUI 27. PSJORD will be an array 59 ; sent by CPRS that contains all the IENS for all orderable items that are part of the order. The zero node of the array 60 ; will contain the total number of orderable items in the order. 61 ; 62 ; PSJQOF is the quick order flag. 0=not a quick order 1=quick order 63 ; 64 ; If there is only one orderable item, any default defined in the Pharmacy Orderable Item file (50.7) will be 65 ; marked with a D at the end of the data string. 66 ; 67 ; If there is more than one orderable item in the order, no default will be sent, and a union (the overlapping) 68 ; of the med routes will be returned. For example if Dextrose can be given IV or IM, and the Ampicillin is only 69 ; given IM, IM is the only med route that will be returned because it is the only overlapping med route between 70 ; the two orderable items. If there is no overlapping med route to be returned, then a NULL will be returned to CPRS. 71 ; 72 ; If the quick order flag PSJQOF is set to 1, then CPRS is expecting the overlapping med routes for the orderable items 73 ; as well as the entire list of med routes that are flagged for IV's. 74 ; 75 I PSJQOF="" S PSJQOF=0 76 K PSJORD1,^TMP("PSJMR",$J) 77 I $G(PSJORD(0))=1 S PSJOPAC="I" D Q 78 . S PSJORD=$P($G(PSJORD(1)),"^",1) 79 . D MEDRT(PSJORD) 80 . I PSJQOF=1 S MCT=$O(^TMP("PSJMR",$J,"A"),-1) D ALLMED(MCT) 81 . M PSJORD1=^TMP("PSJMR",$J) 82 . D REMDUP 83 . K PSJORD 84 . M PSJORD=PSJORD1 85 . K PSJORD1,^TMP("PSJMR",$J) 86 S X=0 87 F S X=$O(PSJORD(X)) Q:X="" D 88 . S PSJORD=$P($G(PSJORD(X)),"^",1) 89 . D MEDRT(PSJORD) 90 . M PSJORD1(X)=^TMP("PSJMR",$J) K ^TMP("PSJMR",$J) ;Start with fresh TMP for each OI 91 D OVERLAP 92 I PSJQOF=1 S MCT=$O(MRTEMP2("A"),-1) D ALLMED(MCT) 93 M PSJORD1=^TMP("PSJMR",$J) 94 D REMDUP 95 K PSJORD 96 M PSJORD=PSJORD1 97 K PSJORD1,MRTEMP2,MRTEMP,MRNODE,MRNODE1,^TMP("PSJMR",$J),PSSCNTR1 98 Q 99 MEDRT(PSJORD) ;All Med Routes for dosage form. 100 N MR,X,PSJDFNO,MCT 101 S (MR,MCT,X,PSJDFNO)=0 102 S PSJDFNO=+$P($G(^PS(50.7,+PSJORD,0)),U,2) 103 S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P($G(^(0)),"^",4)=1 S ^TMP("PSJMR",$J,1)=MR_U_$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_$P(^(0),"^",2)_U_"D",MCT=MCT+1 104 S MR=0 F S MR=$O(^PS(50.606,PSJDFNO,"MR",MR)) Q:'MR D 105 . S X=+$G(^PS(50.606,PSJDFNO,"MR",MR,0)) 106 . I X=$P($G(^PS(50.7,+PSJORD,0)),"^",6) Q ;Already counted as the default. Don't count twice. 107 . S MRNODE=$G(^PS(51.2,X,0)) 108 . I $P($G(MRNODE),"^",4)'=1 Q 109 . S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=X_U_$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_$P(MRNODE,U,2)_U 110 Q 111 ALLMED(MCT) ;Return all med routes with IV flag set to 1 112 N MR,MRNODE 113 I MCT="" S MCT=0 114 S (MR,MRNODE)="" 115 F S MR=$O(^PS(51.2,MR)) Q:MR="" D 116 . S MRNODE=$G(^PS(51.2,MR,0)) 117 . I $P(MRNODE,U,4)'=1 Q ;Not defined for all packages 118 . I $P(MRNODE,U,6)'=1 Q ;IV flag not set 119 . S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=MR_U_$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_$P(MRNODE,U,2)_U 120 Q 121 OVERLAP ; Only maintains any overlapping med routes between orderable items in order 122 N MR,MRNODE,X,PSSCNTR1 123 K MRTEMP,MRTEMP2 124 S (MR,MRNODE,X)="" 125 F S X=$O(PSJORD1(X)) Q:X="" D 126 . F S MR=$O(PSJORD1(X,MR)) Q:MR="" D 127 . . S MRNODE=$P($G(PSJORD1(X,MR)),"^",1) 128 . . S MRTEMP(MRNODE)=$G(MRTEMP(MRNODE))+1 129 S MR="" 130 F S MR=$O(MRTEMP(MR)) Q:MR="" D 131 . I MRTEMP(MR)'=$G(PSJORD(0)) K MRTEMP(MR) Q 132 I '$D(MRTEMP) K PSJORD1 S PSJORD1="" Q ;No overlapping med routes between orderable items. 133 S (MR,MRNODE)="",PSSCNTR1=1 134 F S MR=$O(MRTEMP(MR)) Q:MR="" D 135 . S MRNODE=$G(^PS(51.2,MR,0)) 136 . S MRTEMP2(PSSCNTR1)=MR_U_$P(MRNODE,U,1)_U_$P(MRNODE,U,3)_U_$P(MRNODE,U,2)_U,PSSCNTR1=PSSCNTR1+1 137 K PSJORD1,MRTEMP 138 M PSJORD1=MRTEMP2 139 Q 140 REMDUP ; Remove duplicate entries 141 N MR,MRNODE 142 S MR="",MRNODE="" 143 F S MR=$O(PSJORD1(MR)) Q:MR="" D 144 . S MRNODE=$P($G(PSJORD1(MR)),"^",2) 145 . I $D(MRTEMP(MRNODE)) K PSJORD1(MR) Q 146 . S MRTEMP(MRNODE)=$G(PSJORD1(MR)) 147 . I MR=1,$P($G(PSJORD1(MR)),"^",5)="D" S MRTEMP(MR)=PSJORD1(MR) Q ;Maintain default if there is one. 148 . S MRTEMP(MR)=PSJORD1(MR) 149 S MR="" 150 F S MR=$O(MRTEMP(MR)) Q:MR="" D 151 . I MR'?1.N K MRTEMP(MR) 152 I PSJORD(0)=1 M PSJORD1=MRTEMP 153 K MRTEMP 154 Q 1 PSSJORDF ;BIR/MV-RETURN MED ROUTES(MR) AND INSTRUCTIONS(INS) ;06/26/98 2 ;;1.0;PHARMACY DATA MANAGEMENT;**5,13,34,38,69,113**;9/30/97;Build 1 3 ;; 4 ;* PSJORD is the Orderable Item IEN pass to Pharmacy by OE/RR. 5 ;* 1. If the dosage form is valid, this routine will return all med 6 ;* routes and instructions associated with that dose form. 7 ;* 2. If the dose form is null, this routine will return all med routes 8 ;* that exist in the medication routes file. 9 ;* 3. ^TMP format: 10 ;* ^TMP("PSJMR",$J,#)=MED ROUTE^MED ROUTE ABREVATION^IEN^OUTPATIENT 11 ;* EXPANSION^IV FLAG^DEFAULT FLAG 12 ;* ^TMP("PSJNOUN",$J,D0)=NOUN^VERB^PREPOSITION 13 ;* ^TMP("PSJSCH",$J)=DEFAULT SCHEDULE NAME 14 ; 15 START(PSJORD,PSJOPAC) ; 16 NEW MR,MRNODE,INS,PSJDFNO,X,MCT,Z,PSJOISC 17 I '+PSJORD D MEDROUTE Q 18 S PSJDFNO=+$P($G(^PS(50.7,+PSJORD,0)),U,2) 19 ;S ^TMP("PSJSCH",$J)=$P($G(^PS(50.7,+PSJORD,0)),"^",8) ;default schedule 20 S PSJOISC=$P($G(^PS(50.7,+PSJORD,0)),"^",8) 21 I $G(PSJOPAC)="O"!($G(PSJOPAC)="X") D:$G(PSJOISC)'="" EN^PSSOUTSC(.PSJOISC) S:$G(PSJOISC)'="" ^TMP("PSJSCH",$J)=$G(PSJOISC) G SCPASS 22 I $G(PSJOISC)'="" D EN^PSSGSGUI(.PSJOISC,"I") S:$G(PSJOISC)'="" ^TMP("PSJSCH",$J)=$G(PSJOISC) 23 SCPASS ; 24 I $G(^PS(50.606,PSJDFNO,0))="" D NOD Q:$D(^TMP("PSJMR",$J,1)) D MEDROUTE Q 25 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J) 26 D DF 27 Q 28 ; 29 DF ;* Loop thru DF node to find all available med routes, nouns, and instructions. 30 N VERB,MR,INS,X 31 S (MR,INS,X,MCT)=0 32 S VERB=$P($G(^PS(50.606,PSJDFNO,"MISC")),U) 33 S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P($G(^(0)),"^",4)=1 S ^TMP("PSJMR",$J,1)=$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_MR_U_$P(^(0),"^",2)_U_$S($P(^(0),"^",6):1,1:0)_"^D",MCT=MCT+1 34 S MR=0 F S MR=$O(^PS(50.606,PSJDFNO,"MR",MR)) Q:'MR D 35 . S X=+$G(^PS(50.606,PSJDFNO,"MR",MR,0)) Q:'X!($P($G(^TMP("PSJMR",$J,1)),"^",3)=X) 36 . S MRNODE=$G(^PS(51.2,X,0)) 37 . I $P($G(MRNODE),"^",4)'=1 Q 38 . S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_X_U_$P(MRNODE,U,2)_U_$S($P(MRNODE,U,6):1,1:0) 39 S X=0 40 ;F S INS=$O(^PS(50.606,PSJDFNO,"INS",INS)) Q:'INS S X=X+1,^TMP("PSJINS",$J,X)=VERB_U_$G(^PS(50.606,PSJDFNO,"INS",INS,0)) 41 ;I '$D(^TMP("PSJINS",$J)),VERB]"" S ^TMP("PSJINS",$J,1)=VERB 42 S X=0 43 I $D(^PS(50.606,PSJDFNO,"NOUN")) F Z=0:0 S Z=$O(^PS(50.606,PSJDFNO,"NOUN",Z)) Q:'Z S X=X+1,^TMP("PSJNOUN",$J,X)=$P($G(^PS(50.606,PSJDFNO,"NOUN",Z,0)),U)_U_$P($G(^PS(50.606,PSJDFNO,"MISC")),U)_U_$P($G(^("MISC")),U,3) 44 Q 45 ; 46 MEDROUTE ;* Return all med routes in the med routes file. 47 S (MR,MCT)=0 K ^TMP("PSJMR",$J) 48 F S MR=$O(^PS(51.2,MR)) Q:'MR S MRNODE=^PS(51.2,MR,0) I $P(^PS(51.2,MR,0),"^",4)=1 S MCT=MCT+1,^TMP("PSJMR",$J,MCT)=$P(MRNODE,U)_U_$P(MRNODE,U,3)_U_MR_U_$P(MRNODE,U,2)_U_$S($P(MRNODE,U,6):1,1:0) 49 Q 50 NOD K ^TMP("PSJMR",$J) 51 S MR=+$P($G(^PS(50.7,+PSJORD,0)),"^",6) I MR,$D(^PS(51.2,MR,0)),$P(^PS(51.2,MR,0),"^",4)=1 S ^TMP("PSJMR",$J,1)=$P(^PS(51.2,MR,0),"^")_U_$P(^(0),"^",3)_U_MR_U_$P(^(0),"^",2)_U_$S($P(^(0),"^",6):1,1:0)_"^D" 52 Q
Note:
See TracChangeset
for help on using the changeset viewer.
