source: FOIAVistA/tag/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDOSCX.m@ 636

PSSDOSCX ;BIR/RTR-Dosage conversion routine continued ;03/09/00
 ;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97
 ;Reference to ^PS(50.607 supported by DBIA 2221
 ;
 K PSSLPTX,PSSLPNO
 F PSSD=0:0 S PSSD=$O(^PSDRUG(PSSD)) Q:'PSSD  D  D:$G(PSSONLYI)!($G(PSSONLYO))!($G(PSSBOTH)) LOCAL
 .S (PSSFLAG,PSSONLYI,PSSONLYO,PSSBOTH)=0
 .S PSSND=$P($G(^PSDRUG(PSSD,"ND")),"^",3),PSSND1=$P($G(^("ND")),"^") I 'PSSND!('PSSND1) S PSSBOTH=1 Q
 .S X=$$DFSU^PSNAPIS(PSSND1,PSSND) S PSSDF=$P(X,"^"),PSSST=$P(X,"^",4),PSSUN=$P(X,"^",5) K X
 .I 'PSSDF!('PSSUN)!($G(PSSST)="") S PSSBOTH=1 Q
 .I '$D(^PS(50.606,PSSDF,0))!('$D(^PS(50.607,PSSUN,0))) S PSSBOTH=1 Q
 .I $P($G(^PSDRUG(PSSD,"DOS")),"^")'="" S PSSST=$P($G(^("DOS")),"^")
 .I PSSST'?.N&(PSSST'?.N1".".N) S PSSBOTH=1 Q
 .S (PSSFLAGZ,PSI,PSO)=0 D
 ..I $D(^PS(50.606,"ACONI",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPI",PSSDF,0)) S PSI=1
 ..I $D(^PS(50.606,"ACONO",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPO",PSSDF,0)) S PSO=1
 .I 'PSO,'PSI S PSSBOTH=1 Q
 .I PSI,'PSO D  S PSSONLYO=1 Q
 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD  D
 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
 ...S PSSTODOS=PSSDUPD*PSSST
 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP  S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
 ...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^I",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
 .I 'PSI,PSO D  S PSSONLYI=1 Q
 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD  D
 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
 ...S PSSTODOS=PSSDUPD*PSSST
 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP  S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
 ...S ^PSDRUG(PSSD,"DOS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
 .I PSI,PSO D
 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD  D
 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
 ...S PSSTODOS=PSSDUPD*PSSST
 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP  S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
 ...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
 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
 .I PSI,PSO D  Q
 ..F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD  D
 ...Q:$O(^PSDRUG(PSSD,"DOS1","B",PSSDUPD,0))
 ...Q:$D(^PS(50.606,"ADUPI",PSSDF,PSSDUPD))
 ...S PSSTODOS=PSSDUPD*PSSST
 ...S (PSSLPT,PSSLPTX)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSD,"DOS1",PSSLP)) Q:'PSSLP  S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP
 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
 ...S ^PSDRUG(PSSD,"DPS1",PSSLPT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSD,"DOS1","B",PSSDUPD,PSSLPT)="",^PSDRUG(PSSD,"DOS")=PSSST_"^"_PSSUN
 ...S ^PSDRUG(PSSD,"DOS1",0)="^50.0903^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
END K PSSLPTX,PSSLPNO G END^PSSDOSCR
 ;
LOCAL ;
 K PSSOI,PSSOID,PSDOD,PSDUPDPT,PSNOUN,PSNOUNPT,PSNOUNPA,PSALL,PSSLTOT,PSSLTOTX
 S PSSOI=$P($G(^PSDRUG(PSSD,2)),"^") Q:'PSSOI
 S PSSOID=+$P($G(^PS(50.7,PSSOI,0)),"^",2) Q:'PSSOID
 Q:'$O(^PS(50.606,PSSOID,"NOUN",0))
 I $O(^PS(50.606,PSSOID,"DUPD",0)) D  Q
 .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'=""
 ..Q:PSNOUNPA=""
 ..F PSDOD=0:0 S PSDOD=$O(^PS(50.606,PSSOID,"DUPD",PSDOD)) Q:'PSDOD  S PSDUPDPT=$P($G(^(PSDOD,0)),"^") D:PSDUPDPT'=""
 ...I $G(PSSONLYO),PSNOUNPA'["O" Q
 ...I $G(PSSONLYI),PSNOUNPA'["I" Q
 ...D TEST^PSSDOSCR
 ...S PSALL=$G(PSDUPDPT)_" "_$S($G(PSSNLF):$G(PSSNLX),1:$G(PSNOUNPT)) K PSSNL,PSSNLF,PSSNLX
 ...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
 ...Q:PSSLPNO
 ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
 ...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)
 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'=""
 .Q:PSNOUNPA=""
 .I $G(PSSONLYO),PSNOUNPA'["O" Q
 .I $G(PSSONLYI),PSNOUNPA'["I" Q
 .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
 .Q:PSSLPNO
 .S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
 .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)
 Q