- PSSTRENG ;BIR/RTR-Mismatch Strength Report ;06/28/07
- ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
- ;Reference to ^PS(50.607 supported by DBIA 2221
- EN ;
- DEV ;
- N IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSK,DUOUT,DTOUT,DIRUT,DIROUT,X,Y,DIR
- W !!,"This report will print Dosage information for all entries in the DRUG (#50)",!,"File that have a different Strength than what is in the VA PRODUCT (#50.68)"
- W !,"File match. If these drugs have Local Possible Dosages, you need to be careful",!,"when populating the new Dose Unit and Numeric Dose fields to be used for Dosage"
- W !,"checks, because the Dosage check will be based on the VA Product. This report",!,"can only identify Strength mismatches if the Drug qualifies for Possible"
- W !,"Dosages, and a Strength has been defined in the DRUG (#50) File.",!
- W !?3,"This report is designed for 132 column format!",!
- K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 K IOP,%ZIS,POP W !!,"Nothing queued to print.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
- I $D(IO("Q")) S ZTRTN="START^PSSTRENG",ZTDESC="Mismatch Strength Report" D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
- START ;
- U IO
- N PSSLINE,PSSYEAR,X,X1,X2,PSSOUT,PSSNAME,PSSCT,PSSIEN,PSSA,PSSB,PSSC,PSSD,PSSDV,PSSE,PSSINA,PSSINAD,PSSSTND1,PSSSTND3,PSSSTNDS,PSSSTNDZ
- N PSSNF,PSSUNIT,PSSAPU,PSSNODE,PSSMSG,PSSSTR,PSSNWD,PSSNWDN,PSSFOUND,Y,PSSMSXXX,PSSNWDS,PSSNWDSS
- S X1=DT,X2=-365 D C^%DTC S PSSYEAR=$G(X) K X,X1,X2
- S (PSSOUT,PSSFOUND)=0,PSSDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSCT=1
- K PSSLINE S $P(PSSLINE,"-",130)=""
- D HD
- PASS ;
- S PSSNAME="" F S PSSNAME=$O(^PSDRUG("B",PSSNAME)) Q:PSSNAME=""!($G(PSSOUT)) D
- .F PSSIEN=0:0 S PSSIEN=$O(^PSDRUG("B",PSSNAME,PSSIEN)) Q:'PSSIEN!($G(PSSOUT)) D
- ..Q:'$D(^PSDRUG(PSSIEN,0))
- ..K PSSINA,PSSNF,PSSINAD,PSSUNIT,PSSAPU,PSSNODE,PSSMSG,PSSMSXXX,PSSSTNDS,PSSSTNDZ,PSSSTND1,PSSSTND3,PSSSTR S PSSNF=$S($P($G(^PSDRUG(PSSIEN,0)),"^",9):1,1:0),PSSINA=$P($G(^PSDRUG(PSSIEN,"I")),"^"),PSSNODE=$G(^PSDRUG(PSSIEN,"DOS"))
- ..;Quit if no Strength in File 50
- ..S (PSSMSXXX,PSSSTR)=$P(PSSNODE,"^") S PSSMSXXX=$S($E(PSSMSXXX,1)=".":"0"_PSSMSXXX,1:PSSMSXXX)
- ..I PSSMSXXX="" Q
- ..S PSSSTND1=$P($G(^PSDRUG(PSSIEN,"ND")),"^"),PSSSTND3=$P($G(^("ND")),"^",3)
- ..I 'PSSSTND3!('PSSSTND1) Q
- ..S PSSSTNDZ=$$PROD0^PSNAPIS(+PSSSTND1,+PSSSTND3) S PSSSTNDS=$P(PSSSTNDZ,"^",3) S PSSSTNDS=$S($E(PSSSTNDS,1)=".":"0"_PSSSTNDS,1:PSSSTNDS)
- ..I $G(PSSSTNDS)="" Q
- ..I PSSSTNDS=PSSMSXXX Q
- ..;PSS*1*78 Aadding the Space for Dosages, - Depending on work group decision, you may need to chane this!
- ..S PSSFOUND=1
- ..S PSSMSG=$P($G(^PSDRUG(PSSIEN,0)),"^",10)
- ..S PSSAPU=$P($G(^PSDRUG(PSSIEN,2)),"^",3)
- ..I $G(PSSINA) S PSSINAD=$E(PSSINA,4,5)_"/"_$E(PSSINA,6,7)_"/"_$E(PSSINA,2,3)
- ..I $P(PSSNODE,"^",2) S PSSUNIT=$P($G(^PS(50.607,+$P(PSSNODE,"^",2),0)),"^")
- ..;S PSSSTR=PSSMSXXX
- ..W !!!,"("_$G(PSSIEN)_")",?19,$G(PSSNAME)_$S($G(PSSNF):" *N/F*",1:"") W ?72,"Inactive Date: "_$G(PSSINAD)
- ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ..I $G(PSSMSG)'="" W !?12,$G(PSSMSG)
- ..;I '$O(^PSDRUG(PSSIEN,"DOS1",0)),'$O(^PSDRUG(PSSIEN,"DOS2",0)) Q
- ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ..W !?12,"Strength: "_$G(PSSMSXXX) W ?43,"Units: " I $G(PSSUNIT)'="" W $G(PSSUNIT)
- ..I $G(PSSUNIT)'="",$L(PSSUNIT)>15 W !
- ..W ?66,"Application Package: "_$G(PSSAPU)
- ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ..S PSSA=0 K PSSC,PSSD,PSSE W !?4,"Possible Dosages: " D
- ...F PSSB=0:0 S PSSB=$O(^PSDRUG(PSSIEN,"DOS1",PSSB)) Q:'PSSB!($G(PSSOUT)) S PSSC=$P($G(^(PSSB,0)),"^"),PSSD=$P($G(^(0)),"^",2),PSSE=$P($G(^(0)),"^",3) I $G(PSSC),$G(PSSD) S PSSA=1 D
- ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ....W !?3,"Dispense Units Per Dose: "_$S($E($G(PSSC),1)=".":"0",1:"")_$G(PSSC),?44,"Dose: " D
- .....I $G(PSSUNIT)'["/" W $S($E($G(PSSD),1)=".":"0",1:"")_$G(PSSD)_$G(PSSUNIT) W ?78,"Package: "_$G(PSSE) D OUT Q
- .....D SETD D ZERO W $G(PSSCALC),?78,"Package: "_$G(PSSE) D OUT
- ..Q:$G(PSSOUT)
- ..I 'PSSA W "(None)"
- ..S PSSA=0 W !?4,"Local Possible Dosages: " F PSSB=0:0 S PSSB=$O(^PSDRUG(PSSIEN,"DOS2",PSSB)) Q:'PSSB!($G(PSSOUT)) D
- ...I $P($G(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^")'="" S PSSA=1 D
- ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ....K PSSNWD,PSSNWDN,PSSNWDS,PSSNWDSS
- ....S PSSNWD=$P($G(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^",5) I PSSNWD S PSSNWDN=$P($G(^PS(51.24,+$G(PSSNWD),0)),"^")
- ....W !?6,$P($G(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^")
- ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ....S PSSNWDS=$P($G(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^",6) S PSSNWDSS=$S($E(PSSNWDS,1)=".":"0"_$G(PSSNWDS),1:$G(PSSNWDS))
- ....W !?6,"Numeric Dose: "_$G(PSSNWDSS),?46,"Dose Unit: "_$G(PSSNWDN),?92,"Package: ",$P($G(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^",2)
- ....I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ..Q:$G(PSSOUT) I 'PSSA W "(None)"
- ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ..W !?3,"Note: Strength of "_PSSMSXXX_" does not match NDF strength of "_PSSSTNDS_"."
- ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- ..W !?3,"VA PRODUCT MATCH: "_$P(PSSSTNDZ,"^")
- ..I ($Y+5)>IOSL D HD Q:$G(PSSOUT)
- END ;
- I '$G(PSSOUT),'PSSFOUND W !,"No mismatches found."
- I $G(PSSDV)="P" W !!,"End of Report.",!
- I '$G(PSSOUT),$G(PSSDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- I $G(PSSDV)="C" W !
- E W @IOF
- ENDX K PSSCALC,PSSDFOI,PSSDFOIN,PSSDF,PSSDZZ D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- HD ;
- I $G(PSSDV)="C",$G(PSSCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
- W @IOF
- W !,"Mismatched Strength Report",?119,"PAGE: "_$G(PSSCT),!,PSSLINE S PSSCT=PSSCT+1
- Q
- SETD ;
- N PSSVA,PSSVA1,PSSVB,PSSVB1,PSSDASH,PSSNDFS,PSSDASH2,PSSDASH3,PSSDASH4,PSSDASH5 K PSSCALC
- S PSSDASH=0 S PSSNDFS=$$PSJST^PSNAPIS(+$P($G(^PSDRUG(PSSIEN,"ND")),"^"),+$P($G(^PSDRUG(PSSIEN,"ND")),"^",3)) S PSSNDFS=+$P($G(PSSNDFS),"^",2) I $G(PSSNDFS),$G(PSSSTR),+$G(PSSSTR)'=+$G(PSSNDFS) S PSSDASH=1
- S PSSVA=$P(PSSUNIT,"/"),PSSVB=$P(PSSUNIT,"/",2),PSSVA1=+$G(PSSVA),PSSVB1=+$G(PSSVB)
- I $G(PSSDASH) S PSSDASH2=PSSSTR/PSSNDFS,PSSDASH3=PSSDASH2*PSSC S PSSDASH4=PSSDASH3*$S($G(PSSVB1):PSSVB1,1:1) S PSSDASH5=$S('$G(PSSVB1):PSSDASH4_$G(PSSVB),1:PSSDASH4_$P(PSSVB,PSSVB1,2))
- S PSSCALC=$S('$G(PSSVA1):PSSD,1:($G(PSSVA1)*PSSD))_$S($G(PSSVA1):$P(PSSVA,PSSVA1,2),1:PSSVA)_"/"_$S($G(PSSDASH):$G(PSSDASH5),'$G(PSSVB1):+$G(PSSC)_$G(PSSVB),1:(+$G(PSSC)*+PSSVB1)_$P(PSSVB,PSSVB1,2))
- Q
- OUT ;
- K PSSDFOI,PSSDFOIN,PSSDF,PSSDZZ
- Q:$G(PSSE)'["O"
- S PSSDFOI=$P($G(^PSDRUG(PSSIEN,2)),"^") Q:'PSSDFOI
- S PSSDF=$P($G(^PS(50.7,+PSSDFOI,0)),"^",2)
- S PSSDFOIN=$P($G(^PS(50.606,+$G(PSSDF),0)),"^")
- Q:'PSSDF
- K PSSDZ F PSSDZZ=0:0 S PSSDZZ=$O(^PS(50.606,PSSDF,"NOUN",PSSDZZ)) Q:'PSSDZZ!($G(PSSDZ)'="") I $P($G(^(PSSDZZ,0)),"^")'="" S PSSDZ=$P($G(^(0)),"^")
- I $G(PSSDZ)="" S PSSDZ=$G(PSSDFOIN)
- I $G(PSSC) D PARN
- W ?94,$S($E($G(PSSC),1)=".":"0",1:"")_$G(PSSC)_" "_$S($G(PSSDZN)'="":$G(PSSDZN),1:$G(PSSDZ))
- K PSSDFOI,PSSDF,PSSDZ,PSSDZZ,PSSDZN,PSSDZNX,PSSDFOIN
- Q
- PARN ;
- K PSSDZN,PSSDZNX
- Q:$G(PSSDZ)=""
- Q:$L(PSSDZ)'>3
- S PSSDZNX=$E(PSSDZ,($L(PSSDZ)-2),$L(PSSDZ))
- I $G(PSSDZNX)="(S)"!($G(PSSDZNX)="(s)") D
- .I $G(PSSC)'>1 S PSSDZN=$E(PSSDZ,1,($L(PSSDZ)-3))
- .I $G(PSSC)>1 S PSSDZN=$E(PSSDZ,1,($L(PSSDZ)-3))_$E(PSSDZNX,2)
- Q
- ZERO ;Leading zeros
- I $E($G(PSSCALC),1)="." S PSSCALC="0"_$G(PSSCALC)
- N PSSLEZ,PSSLEZ1,PSSLEZD
- I $G(PSSCALC)["/." S PSSLEZD=$G(PSSCALC) D
- .S PSSLEZ=$P(PSSLEZD,"/."),PSSLEZ1=$P(PSSLEZD,"/.",2)
- .S PSSCALC=$G(PSSLEZ)_"/0."_$G(PSSLEZ1)
- Q
- PSSTRENG ;BIR/RTR-Mismatch Strength Report ;06/28/07
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
- +2 ;Reference to ^PS(50.607 supported by DBIA 2221
- EN ;
- DEV ;
- +1 NEW IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSK,DUOUT,DTOUT,DIRUT,DIROUT,X,Y,DIR
- +2 WRITE !!,"This report will print Dosage information for all entries in the DRUG (#50)",!,"File that have a different Strength than what is in the VA PRODUCT (#50.68)"
- +3 WRITE !,"File match. If these drugs have Local Possible Dosages, you need to be careful",!,"when populating the new Dose Unit and Numeric Dose fields to be used for Dosage"
- +4 WRITE !,"checks, because the Dosage check will be based on the VA Product. This report",!,"can only identify Strength mismatches if the Drug qualifies for Possible"
- +5 WRITE !,"Dosages, and a Strength has been defined in the DRUG (#50) File.",!
- +6 WRITE !?3,"This report is designed for 132 column format!",!
- +7 KILL IOP,%ZIS,POP
- SET %ZIS="QM"
- DO ^%ZIS
- IF $GET(POP)>0
- KILL IOP,%ZIS,POP
- WRITE !!,"Nothing queued to print.",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- QUIT
- +8 IF $DATA(IO("Q"))
- SET ZTRTN="START^PSSTRENG"
- SET ZTDESC="Mismatch Strength Report"
- DO ^%ZTLOAD
- KILL %ZIS
- WRITE !!,"Report queued to print.",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- QUIT
- START ;
- +1 USE IO
- +2 NEW PSSLINE,PSSYEAR,X,X1,X2,PSSOUT,PSSNAME,PSSCT,PSSIEN,PSSA,PSSB,PSSC,PSSD,PSSDV,PSSE,PSSINA,PSSINAD,PSSSTND1,PSSSTND3,PSSSTNDS,PSSSTNDZ
- +3 NEW PSSNF,PSSUNIT,PSSAPU,PSSNODE,PSSMSG,PSSSTR,PSSNWD,PSSNWDN,PSSFOUND,Y,PSSMSXXX,PSSNWDS,PSSNWDSS
- +4 SET X1=DT
- SET X2=-365
- DO C^%DTC
- SET PSSYEAR=$GET(X)
- KILL X,X1,X2
- +5 SET (PSSOUT,PSSFOUND)=0
- SET PSSDV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
- SET PSSCT=1
- +6 KILL PSSLINE
- SET $PIECE(PSSLINE,"-",130)=""
- +7 DO HD
- PASS ;
- +1 SET PSSNAME=""
- FOR
- SET PSSNAME=$ORDER(^PSDRUG("B",PSSNAME))
- IF PSSNAME=""!($GET(PSSOUT))
- QUIT
- Begin DoDot:1
- +2 FOR PSSIEN=0:0
- SET PSSIEN=$ORDER(^PSDRUG("B",PSSNAME,PSSIEN))
- IF 'PSSIEN!($GET(PSSOUT))
- QUIT
- Begin DoDot:2
- +3 IF '$DATA(^PSDRUG(PSSIEN,0))
- QUIT
- +4 KILL PSSINA,PSSNF,PSSINAD,PSSUNIT,PSSAPU,PSSNODE,PSSMSG,PSSMSXXX,PSSSTNDS,PSSSTNDZ,PSSSTND1,PSSSTND3,PSSSTR
- SET PSSNF=$SELECT($PIECE($GET(^PSDRUG(PSSIEN,0)),"^",9):1,1:0)
- SET PSSINA=$PIECE($GET(^PSDRUG(PSSIEN,"I")),"^")
- SET PSSNODE=$GET(^PSDRUG(PSSIEN,"DOS"))
- +5 ;Quit if no Strength in File 50
- +6 SET (PSSMSXXX,PSSSTR)=$PIECE(PSSNODE,"^")
- SET PSSMSXXX=$SELECT($EXTRACT(PSSMSXXX,1)=".":"0"_PSSMSXXX,1:PSSMSXXX)
- +7 IF PSSMSXXX=""
- QUIT
- +8 SET PSSSTND1=$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^")
- SET PSSSTND3=$PIECE($GET(^("ND")),"^",3)
- +9 IF 'PSSSTND3!('PSSSTND1)
- QUIT
- +10 SET PSSSTNDZ=$$PROD0^PSNAPIS(+PSSSTND1,+PSSSTND3)
- SET PSSSTNDS=$PIECE(PSSSTNDZ,"^",3)
- SET PSSSTNDS=$SELECT($EXTRACT(PSSSTNDS,1)=".":"0"_PSSSTNDS,1:PSSSTNDS)
- +11 IF $GET(PSSSTNDS)=""
- QUIT
- +12 IF PSSSTNDS=PSSMSXXX
- QUIT
- +13 ;PSS*1*78 Aadding the Space for Dosages, - Depending on work group decision, you may need to chane this!
- +14 SET PSSFOUND=1
- +15 SET PSSMSG=$PIECE($GET(^PSDRUG(PSSIEN,0)),"^",10)
- +16 SET PSSAPU=$PIECE($GET(^PSDRUG(PSSIEN,2)),"^",3)
- +17 IF $GET(PSSINA)
- SET PSSINAD=$EXTRACT(PSSINA,4,5)_"/"_$EXTRACT(PSSINA,6,7)_"/"_$EXTRACT(PSSINA,2,3)
- +18 IF $PIECE(PSSNODE,"^",2)
- SET PSSUNIT=$PIECE($GET(^PS(50.607,+$PIECE(PSSNODE,"^",2),0)),"^")
- +19 ;S PSSSTR=PSSMSXXX
- +20 WRITE !!!,"("_$GET(PSSIEN)_")",?19,$GET(PSSNAME)_$SELECT($GET(PSSNF):" *N/F*",1:"")
- WRITE ?72,"Inactive Date: "_$GET(PSSINAD)
- +21 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +22 IF $GET(PSSMSG)'=""
- WRITE !?12,$GET(PSSMSG)
- +23 ;I '$O(^PSDRUG(PSSIEN,"DOS1",0)),'$O(^PSDRUG(PSSIEN,"DOS2",0)) Q
- +24 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +25 WRITE !?12,"Strength: "_$GET(PSSMSXXX)
- WRITE ?43,"Units: "
- IF $GET(PSSUNIT)'=""
- WRITE $GET(PSSUNIT)
- +26 IF $GET(PSSUNIT)'=""
- IF $LENGTH(PSSUNIT)>15
- WRITE !
- +27 WRITE ?66,"Application Package: "_$GET(PSSAPU)
- +28 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +29 SET PSSA=0
- KILL PSSC,PSSD,PSSE
- WRITE !?4,"Possible Dosages: "
- Begin DoDot:3
- +30 FOR PSSB=0:0
- SET PSSB=$ORDER(^PSDRUG(PSSIEN,"DOS1",PSSB))
- IF 'PSSB!($GET(PSSOUT))
- QUIT
- SET PSSC=$PIECE($GET(^(PSSB,0)),"^")
- SET PSSD=$PIECE($GET(^(0)),"^",2)
- SET PSSE=$PIECE($GET(^(0)),"^",3)
- IF $GET(PSSC)
- IF $GET(PSSD)
- SET PSSA=1
- Begin DoDot:4
- +31 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +32 WRITE !?3,"Dispense Units Per Dose: "_$SELECT($EXTRACT($GET(PSSC),1)=".":"0",1:"")_$GET(PSSC),?44,"Dose: "
- Begin DoDot:5
- +33 IF $GET(PSSUNIT)'["/"
- WRITE $SELECT($EXTRACT($GET(PSSD),1)=".":"0",1:"")_$GET(PSSD)_$GET(PSSUNIT)
- WRITE ?78,"Package: "_$GET(PSSE)
- DO OUT
- QUIT
- +34 DO SETD
- DO ZERO
- WRITE $GET(PSSCALC),?78,"Package: "_$GET(PSSE)
- DO OUT
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +35 IF $GET(PSSOUT)
- QUIT
- +36 IF 'PSSA
- WRITE "(None)"
- +37 SET PSSA=0
- WRITE !?4,"Local Possible Dosages: "
- FOR PSSB=0:0
- SET PSSB=$ORDER(^PSDRUG(PSSIEN,"DOS2",PSSB))
- IF 'PSSB!($GET(PSSOUT))
- QUIT
- Begin DoDot:3
- +38 IF $PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^")'=""
- SET PSSA=1
- Begin DoDot:4
- +39 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +40 KILL PSSNWD,PSSNWDN,PSSNWDS,PSSNWDSS
- +41 SET PSSNWD=$PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^",5)
- IF PSSNWD
- SET PSSNWDN=$PIECE($GET(^PS(51.24,+$GET(PSSNWD),0)),"^")
- +42 WRITE !?6,$PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^")
- +43 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +44 SET PSSNWDS=$PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^",6)
- SET PSSNWDSS=$SELECT($EXTRACT(PSSNWDS,1)=".":"0"_$GET(PSSNWDS),1:$GET(PSSNWDS))
- +45 WRITE !?6,"Numeric Dose: "_$GET(PSSNWDSS),?46,"Dose Unit: "_$GET(PSSNWDN),?92,"Package: ",$PIECE($GET(^PSDRUG(PSSIEN,"DOS2",PSSB,0)),"^",2)
- +46 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- End DoDot:4
- End DoDot:3
- +47 IF $GET(PSSOUT)
- QUIT
- IF 'PSSA
- WRITE "(None)"
- +48 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +49 WRITE !?3,"Note: Strength of "_PSSMSXXX_" does not match NDF strength of "_PSSSTNDS_"."
- +50 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- +51 WRITE !?3,"VA PRODUCT MATCH: "_$PIECE(PSSSTNDZ,"^")
- +52 IF ($Y+5)>IOSL
- DO HD
- IF $GET(PSSOUT)
- QUIT
- End DoDot:2
- End DoDot:1
- END ;
- +1 IF '$GET(PSSOUT)
- IF 'PSSFOUND
- WRITE !,"No mismatches found."
- +2 IF $GET(PSSDV)="P"
- WRITE !!,"End of Report.",!
- +3 IF '$GET(PSSOUT)
- IF $GET(PSSDV)="C"
- WRITE !!,"End of Report."
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +4 IF $GET(PSSDV)="C"
- WRITE !
- +5 IF '$TEST
- WRITE @IOF
- ENDX KILL PSSCALC,PSSDFOI,PSSDFOIN,PSSDF,PSSDZZ
- DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 QUIT
- HD ;
- +1 IF $GET(PSSDV)="C"
- IF $GET(PSSCT)'=1
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue, '^' to exit"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSSOUT=1
- QUIT
- +2 WRITE @IOF
- +3 WRITE !,"Mismatched Strength Report",?119,"PAGE: "_$GET(PSSCT),!,PSSLINE
- SET PSSCT=PSSCT+1
- +4 QUIT
- SETD ;
- +1 NEW PSSVA,PSSVA1,PSSVB,PSSVB1,PSSDASH,PSSNDFS,PSSDASH2,PSSDASH3,PSSDASH4,PSSDASH5
- KILL PSSCALC
- +2 SET PSSDASH=0
- SET PSSNDFS=$$PSJST^PSNAPIS(+$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^"),+$PIECE($GET(^PSDRUG(PSSIEN,"ND")),"^",3))
- SET PSSNDFS=+$PIECE($GET(PSSNDFS),"^",2)
- IF $GET(PSSNDFS)
- IF $GET(PSSSTR)
- IF +$GET(PSSSTR)'=+$GET(PSSNDFS)
- SET PSSDASH=1
- +3 SET PSSVA=$PIECE(PSSUNIT,"/")
- SET PSSVB=$PIECE(PSSUNIT,"/",2)
- SET PSSVA1=+$GET(PSSVA)
- SET PSSVB1=+$GET(PSSVB)
- +4 IF $GET(PSSDASH)
- SET PSSDASH2=PSSSTR/PSSNDFS
- SET PSSDASH3=PSSDASH2*PSSC
- SET PSSDASH4=PSSDASH3*$SELECT($GET(PSSVB1):PSSVB1,1:1)
- SET PSSDASH5=$SELECT('$GET(PSSVB1):PSSDASH4_$GET(PSSVB),1:PSSDASH4_$PIECE(PSSVB,PSSVB1,2))
- +5 SET PSSCALC=$SELECT('$GET(PSSVA1):PSSD,1:($GET(PSSVA1)*PSSD))_$SELECT($GET(PSSVA1):$PIECE(PSSVA,PSSVA1,2),1:PSSVA)_"/"_$SELECT($GET(PSSDASH):$GET(PSSDASH5),'$GET(PSSVB1):+$GET(PSSC)_$GET(PSSVB),1:(+$GET(PSSC)*+PSSVB1)_$PIECE(PSSVB,PSSVB1,2))
- +6 QUIT
- OUT ;
- +1 KILL PSSDFOI,PSSDFOIN,PSSDF,PSSDZZ
- +2 IF $GET(PSSE)'["O"
- QUIT
- +3 SET PSSDFOI=$PIECE($GET(^PSDRUG(PSSIEN,2)),"^")
- IF 'PSSDFOI
- QUIT
- +4 SET PSSDF=$PIECE($GET(^PS(50.7,+PSSDFOI,0)),"^",2)
- +5 SET PSSDFOIN=$PIECE($GET(^PS(50.606,+$GET(PSSDF),0)),"^")
- +6 IF 'PSSDF
- QUIT
- +7 KILL PSSDZ
- FOR PSSDZZ=0:0
- SET PSSDZZ=$ORDER(^PS(50.606,PSSDF,"NOUN",PSSDZZ))
- IF 'PSSDZZ!($GET(PSSDZ)'="")
- QUIT
- IF $PIECE($GET(^(PSSDZZ,0)),"^")'=""
- SET PSSDZ=$PIECE($GET(^(0)),"^")
- +8 IF $GET(PSSDZ)=""
- SET PSSDZ=$GET(PSSDFOIN)
- +9 IF $GET(PSSC)
- DO PARN
- +10 WRITE ?94,$SELECT($EXTRACT($GET(PSSC),1)=".":"0",1:"")_$GET(PSSC)_" "_$SELECT($GET(PSSDZN)'="":$GET(PSSDZN),1:$GET(PSSDZ))
- +11 KILL PSSDFOI,PSSDF,PSSDZ,PSSDZZ,PSSDZN,PSSDZNX,PSSDFOIN
- +12 QUIT
- PARN ;
- +1 KILL PSSDZN,PSSDZNX
- +2 IF $GET(PSSDZ)=""
- QUIT
- +3 IF $LENGTH(PSSDZ)'>3
- QUIT
- +4 SET PSSDZNX=$EXTRACT(PSSDZ,($LENGTH(PSSDZ)-2),$LENGTH(PSSDZ))
- +5 IF $GET(PSSDZNX)="(S)"!($GET(PSSDZNX)="(s)")
- Begin DoDot:1
- +6 IF $GET(PSSC)'>1
- SET PSSDZN=$EXTRACT(PSSDZ,1,($LENGTH(PSSDZ)-3))
- +7 IF $GET(PSSC)>1
- SET PSSDZN=$EXTRACT(PSSDZ,1,($LENGTH(PSSDZ)-3))_$EXTRACT(PSSDZNX,2)
- End DoDot:1
- +8 QUIT
- ZERO ;Leading zeros
- +1 IF $EXTRACT($GET(PSSCALC),1)="."
- SET PSSCALC="0"_$GET(PSSCALC)
- +2 NEW PSSLEZ,PSSLEZ1,PSSLEZD
- +3 IF $GET(PSSCALC)["/."
- SET PSSLEZD=$GET(PSSCALC)
- Begin DoDot:1
- +4 SET PSSLEZ=$PIECE(PSSLEZD,"/.")
- SET PSSLEZ1=$PIECE(PSSLEZD,"/.",2)
- +5 SET PSSCALC=$GET(PSSLEZ)_"/0."_$GET(PSSLEZ1)
- End DoDot:1
- +6 QUIT
