- PSSUTIL3 ;BIR/SJA-utility routine for NDF changes ;07/09/10
- ;;1.0;PHARMACY DATA MANAGEMENT;**155**;9/30/97;Build 36
- ;
- EN2 N PSSPKG
- S PSSPKG=$P($$POSDOS^PSNAPIS(PSSND),"^",3)
- D S:PSSTOT>1 PSSTOTX=PSSTOT-1,^PSDRUG(PSSDIEN,"DOS")=PSSST_"^"_PSSUN,PSSONLYO=1,PSSBOTH=0,^PSDRUG(PSSDIEN,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX) I '(PSSI&PSSO) G LOC^PSSUTIL
- .S PSSTOT=1 F PSSDUPD=1,2 D
- ..I PSSUPRA="NO"&(PSSDUPD=2) Q
- ..S PSSTODOS=PSSDUPD*PSSST
- ..S ^PSDRUG(PSSDIEN,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^"_PSSPKG,^PSDRUG(PSSDIEN,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
- Q
- TEST ;
- K PSSNL,PSSNLF,PSSNLX
- Q:$G(PSNOUNPT)=""
- Q:$L(PSNOUNPT)'>3
- S PSSNL=$E(PSNOUNPT,($L(PSNOUNPT)-2),$L(PSNOUNPT))
- I $G(PSSNL)="(S)"!($G(PSSNL)="(s)") S PSSNLF=1 D
- .I $G(PSDUPDPT)'>1 S PSSNLX=$E(PSNOUNPT,1,($L(PSNOUNPT)-3))
- .I $G(PSDUPDPT)>1 S PSSNLX=$E(PSNOUNPT,1,($L(PSNOUNPT)-3))_$E(PSSNL,2)
- Q
- SUPRA(PSSND) ; set supra flag
- N PSSDOS,PSSCD,PSSDOSC,PSSPKG
- S PSSDOS=$$POSDOS^PSNAPIS(PSSND),PSSCD=$P(PSSDOS,"^"),PSSDOSC=$P(PSSDOS,"^",2),PSSPKG=$P(PSSDOS,"^",3)
- Q $S(PSSCD="N"&(PSSDOSC="O"):"NO",(PSSCD="N")&(PSSDOSC="B"):"NB",(PSSCD="N")&(PSSDOSC="N"):"NN",1:"")
- ;
- CHECK(PSSIEN) ; check if the drug meets the criteria to have Possible Dosages
- N PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNATST
- D NATND
- I 'PSSNATDF!('PSSNATUN)!($G(PSSNATST)="") Q 0
- I '$D(^PS(50.606,PSSNATDF,0))!('$D(^PS(50.607,PSSNATUN,0))) Q 0
- I PSSNATST'?.N&(PSSNATST'?.N1".".N) Q 0
- I $D(^PS(50.606,"ACONI",PSSNATDF,PSSNATUN)),$O(^PS(50.606,"ADUPI",PSSNATDF,0)) Q 1
- I $D(^PS(50.606,"ACONO",PSSNATDF,PSSNATUN)),$O(^PS(50.606,"ADUPO",PSSNATDF,0)) Q 1
- Q 0
- NATND S PSSNAT=+$P($G(^PSDRUG(PSSIEN,"ND")),"^",3),PSSNAT1=$P($G(^("ND")),"^")
- S PSSNATND=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT)
- S PSSNATDF=$P(PSSNATND,"^"),PSSNATST=$P(PSSNATND,"^",4),PSSNATUN=$P(PSSNATND,"^",5)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSUTIL3 1882 printed Feb 19, 2025@00:00:37 Page 2
- PSSUTIL3 ;BIR/SJA-utility routine for NDF changes ;07/09/10
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**155**;9/30/97;Build 36
- +2 ;
- EN2 NEW PSSPKG
- +1 SET PSSPKG=$PIECE($$POSDOS^PSNAPIS(PSSND),"^",3)
- +2 Begin DoDot:1
- +3 SET PSSTOT=1
- FOR PSSDUPD=1,2
- Begin DoDot:2
- +4 IF PSSUPRA="NO"&(PSSDUPD=2)
- QUIT
- +5 SET PSSTODOS=PSSDUPD*PSSST
- +6 SET ^PSDRUG(PSSDIEN,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^"_PSSPKG
- SET ^PSDRUG(PSSDIEN,"DOS1","B",PSSDUPD,PSSTOT)=""
- SET PSSTOT=PSSTOT+1
- End DoDot:2
- End DoDot:1
- if PSSTOT>1
- SET PSSTOTX=PSSTOT-1
- SET ^PSDRUG(PSSDIEN,"DOS")=PSSST_"^"_PSSUN
- SET PSSONLYO=1
- SET PSSBOTH=0
- SET ^PSDRUG(PSSDIEN,"DOS1",0)="^50.0903^"_$GET(PSSTOTX)_"^"_$GET(PSSTOTX)
- IF '(PSSI&PSSO)
- GOTO LOC^PSSUTIL
- +7 QUIT
- TEST ;
- +1 KILL PSSNL,PSSNLF,PSSNLX
- +2 if $GET(PSNOUNPT)=""
- QUIT
- +3 if $LENGTH(PSNOUNPT)'>3
- QUIT
- +4 SET PSSNL=$EXTRACT(PSNOUNPT,($LENGTH(PSNOUNPT)-2),$LENGTH(PSNOUNPT))
- +5 IF $GET(PSSNL)="(S)"!($GET(PSSNL)="(s)")
- SET PSSNLF=1
- Begin DoDot:1
- +6 IF $GET(PSDUPDPT)'>1
- SET PSSNLX=$EXTRACT(PSNOUNPT,1,($LENGTH(PSNOUNPT)-3))
- +7 IF $GET(PSDUPDPT)>1
- SET PSSNLX=$EXTRACT(PSNOUNPT,1,($LENGTH(PSNOUNPT)-3))_$EXTRACT(PSSNL,2)
- End DoDot:1
- +8 QUIT
- SUPRA(PSSND) ; set supra flag
- +1 NEW PSSDOS,PSSCD,PSSDOSC,PSSPKG
- +2 SET PSSDOS=$$POSDOS^PSNAPIS(PSSND)
- SET PSSCD=$PIECE(PSSDOS,"^")
- SET PSSDOSC=$PIECE(PSSDOS,"^",2)
- SET PSSPKG=$PIECE(PSSDOS,"^",3)
- +3 QUIT $SELECT(PSSCD="N"&(PSSDOSC="O"):"NO",(PSSCD="N")&(PSSDOSC="B"):"NB",(PSSCD="N")&(PSSDOSC="N"):"NN",1:"")
- +4 ;
- CHECK(PSSIEN) ; check if the drug meets the criteria to have Possible Dosages
- +1 NEW PSSNAT,PSSNAT1,PSSNATND,PSSNATDF,PSSNATUN,PSSNATST
- +2 DO NATND
- +3 IF 'PSSNATDF!('PSSNATUN)!($GET(PSSNATST)="")
- QUIT 0
- +4 IF '$DATA(^PS(50.606,PSSNATDF,0))!('$DATA(^PS(50.607,PSSNATUN,0)))
- QUIT 0
- +5 IF PSSNATST'?.N&(PSSNATST'?.N1".".N)
- QUIT 0
- +6 IF $DATA(^PS(50.606,"ACONI",PSSNATDF,PSSNATUN))
- IF $ORDER(^PS(50.606,"ADUPI",PSSNATDF,0))
- QUIT 1
- +7 IF $DATA(^PS(50.606,"ACONO",PSSNATDF,PSSNATUN))
- IF $ORDER(^PS(50.606,"ADUPO",PSSNATDF,0))
- QUIT 1
- +8 QUIT 0
- NATND SET PSSNAT=+$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^",3)
- SET PSSNAT1=$PIECE($GET(^("ND")),"^")
- +1 SET PSSNATND=$$DFSU^PSNAPIS(PSSNAT1,PSSNAT)
- +2 SET PSSNATDF=$PIECE(PSSNATND,"^")
- SET PSSNATST=$PIECE(PSSNATND,"^",4)
- SET PSSNATUN=$PIECE(PSSNATND,"^",5)
- +3 QUIT