source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDOSCX.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1PSSDOSCX ;BIR/RTR-Dosage conversion routine continued ;03/09/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97
3 ;Reference to ^PS(50.607 supported by DBIA 2221
4 ;
5 K PSSLPTX,PSSLPNO
6 F PSSD=0:0 S PSSD=$O(^PSDRUG(PSSD)) Q:'PSSD D D:$G(PSSONLYI)!($G(PSSONLYO))!($G(PSSBOTH)) LOCAL
7 .S (PSSFLAG,PSSONLYI,PSSONLYO,PSSBOTH)=0
8 .S PSSND=$P($G(^PSDRUG(PSSD,"ND")),"^",3),PSSND1=$P($G(^("ND")),"^") I 'PSSND!('PSSND1) S PSSBOTH=1 Q
9 .S X=$$DFSU^PSNAPIS(PSSND1,PSSND) S PSSDF=$P(X,"^"),PSSST=$P(X,"^",4),PSSUN=$P(X,"^",5) K X
10 .I 'PSSDF!('PSSUN)!($G(PSSST)="") S PSSBOTH=1 Q
11 .I '$D(^PS(50.606,PSSDF,0))!('$D(^PS(50.607,PSSUN,0))) S PSSBOTH=1 Q
12 .I $P($G(^PSDRUG(PSSD,"DOS")),"^")'="" S PSSST=$P($G(^("DOS")),"^")
13 .I PSSST'?.N&(PSSST'?.N1".".N) S PSSBOTH=1 Q
14 .S (PSSFLAGZ,PSI,PSO)=0 D
15 ..I $D(^PS(50.606,"ACONI",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPI",PSSDF,0)) S PSI=1
16 ..I $D(^PS(50.606,"ACONO",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPO",PSSDF,0)) S PSO=1
17 .I 'PSO,'PSI S PSSBOTH=1 Q
18 .I PSI,'PSO D S PSSONLYO=1 Q
19 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
20 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
21 ...S PSSTODOS=PSSDUPD*PSSST
22 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
23 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
24 ...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^I",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
25 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
26 .I 'PSI,PSO D S PSSONLYI=1 Q
27 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
28 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
29 ...S PSSTODOS=PSSDUPD*PSSST
30 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
31 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
32 ...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
33 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
34 .I PSI,PSO D
35 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
36 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
37 ...S PSSTODOS=PSSDUPD*PSSST
38 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
39 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
40 ...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS S $P(^PSDRUG(PSSD,"DOS1",PSSLPT,0),"^",3)=$S($D(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)):"IO",1:"I") S ^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
41 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
42 .I PSI,PSO D Q
43 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
44 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
45 ...Q:$D(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
46 ...S PSSTODOS=PSSDUPD*PSSST
47 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
48 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
49 ...S ^PSDRUG(PSSD,"DPS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
50 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
51END K PSSLPTX,PSSLPNO G END^PSSDOSCR
52 ;
53LOCAL ;
54 K PSSOI,PSSOID,PSDOD,PSDUPDPT,PSNOUN,PSNOUNPT,PSNOUNPA,PSALL,PSSLTOT,PSSLTOTX
55 S PSSOI=$P($G(^PSDRUG(PSSD,2)),"^") Q:'PSSOI
56 S PSSOID=+$P($G(^PS(50.7,PSSOI,0)),"^",2) Q:'PSSOID
57 Q:'$O(^PS(50.606,PSSOID,"NOUN",0))
58 I $O(^PS(50.606,PSSOID,"DUPD",0)) D Q
59 .F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
60 ..Q:PSNOUNPA=""
61 ..F PSDOD=0:0 S PSDOD=$O(^PS(50.606,PSSOID,"DUPD",PSDOD)) Q:'PSDOD S PSDUPDPT=$P($G(^(PSDOD,0)),"^") D:PSDUPDPT'=""
62 ...I $G(PSSONLYO),PSNOUNPA'["O" Q
63 ...I $G(PSSONLYI),PSNOUNPA'["I" Q
64 ...D TEST^PSSDOSCR
65 ...S PSALL=$G(PSDUPDPT)_" "_$S($G(PSSNLF):$G(PSSNLX),1:$G(PSNOUNPT)) K PSSNL,PSSNLF,PSSNLX
66 ...S (PSSLPT,PSSLPTX,PSSLPNO)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS2",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP I PSALL=$P($G(^PSDRUG(PSSD,"DOS2",PSSLP,0)),"^") S PSSLPNO=1
67 ...Q:PSSLPNO
68 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
69 ...S ^PSDRUG(PSSD,"DOS2",PSSLPT,0)=$G(PSALL)_"^"_$G(PSNOUNPA),^PSDRUG(PSSD,"DOS2","B",$E(PSALL,1,30),PSSLPT)="",^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
70 F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
71 .Q:PSNOUNPA=""
72 .I $G(PSSONLYO),PSNOUNPA'["O" Q
73 .I $G(PSSONLYI),PSNOUNPA'["I" Q
74 .S (PSSLPT,PSSLPTX,PSSLPNO)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS2",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP I PSNOUNPT=$P($G(^PSDRUG(PSSD,"DOS2",PSSLP,0)),"^") S PSSLPNO=1
75 .Q:PSSLPNO
76 .S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
77 .S ^PSDRUG(PSSD,"DOS2",PSSLPT,0)=$G(PSNOUNPT)_"^"_$G(PSNOUNPA),^PSDRUG(PSSD,"DOS2","B",$E(PSNOUNPT,1,30),PSSLPT)="",^PSDRUG(PSSD,"DOS2",0)="^50.0904^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
78 Q
Note: See TracBrowser for help on using the repository browser.