- PSSLDOSE ;BIR/RTR-Local Possible Dosages Report ;06/22/07
- ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
- ;
- ;External reference to PS(50.607 supported by DBIA 2221
- ;
- EN ;
- W !!,"This report will print Local Possible Dosage information only for Drugs for"
- W !,"which Dosage Checks can be performed. Drugs that are inactive, marked and/or"
- W !,"classed as supply items, not matched to NDF or excluded from dosage checks (due"
- W !,"to dosage form or VA Product override) will not be included in this report."
- W !!,"Users will be able to print Local Possible Dosage information for all eligible"
- W !,"drugs or only for drugs with missing data in the Numeric Dose and Dose Unit"
- W !,"fields. These two fields must be populated to perform Dosage Checks for a Local"
- W !,"Possible Dosage selected when placing a Pharmacy order."
- N DIR,PSSKZTPE,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
- K DIR S DIR(0)="SO^A:ALL LOCAL POSSIBLE DOSAGES;O:ONLY LOCAL POSSIBLE DOSAGE WITH MISSING DATA",DIR("A")="Enter 'A' for All, 'O' for Only",DIR("B")="O"
- S DIR("?")=" ",DIR("?",1)="Enter 'A' to see All Local Possible Dosages, regardless of whether or not the ",DIR("?",2)="associated Numeric Dose and Dose Unit fields are populated. Enter 'O' to see"
- S DIR("?",3)="only those Local Possible Dosages with missing data in either the Numeric Dose",DIR("?",4)="or Dose Unit fields. The two fields must be populated if Dosage Checks are"
- S DIR("?",5)="to be performed when this Local Possible Dosage is selected when placing a",DIR("?",6)="Pharmacy order."
- D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
- I Y'="A",Y'="O" D MESS K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
- S PSSKZTPE=Y
- W !!,"This report is designed for 132 column format!",!
- K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 D MESS K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,IOP,%ZIS,POP Q
- I $D(IO("Q")) S ZTRTN="START^PSSLDOSE",ZTDESC="Local Possible Dosages Report",ZTSAVE("PSSKZTPE")="" D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",! D Q
- .K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- ;
- ;
- START ;Print Local Possible Dosages Report
- U IO
- N PSSKZDEV,PSSKZCT,PSSKZOUT,PSSKZLIN,PSSKZNOF,PSSKZNM,PSSKZIEN,PSSKZOK,PSSKZDAT,PSSKZLIP,PSSKZND1,PSSKZND3,PSSKZZR,PSSKZNDF,PSSKZDF,PSSKZDT1,PSSKZLP1
- N PSSKZNFL,PSSKZMSG,PSSKZSTR,PSSKZUNT,PSSKZUNZ,PSSKZAPU,PSSKZ1,PSSKZ2,PSSKZ3,PSSKZLD5,PSSKZLD6,PSSKZLD7,PSSKZNN1,PSSKZNN2
- S (PSSKZOUT,PSSKZNOF)=0,PSSKZDEV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSKZCT=1
- K PSSKZLIN S $P(PSSKZLIN,"-",130)=""
- D HD
- S PSSKZNM="" F S PSSKZNM=$O(^PSDRUG("B",PSSKZNM)) Q:PSSKZNM=""!(PSSKZOUT) F PSSKZIEN=0:0 S PSSKZIEN=$O(^PSDRUG("B",PSSKZNM,PSSKZIEN)) Q:'PSSKZIEN!(PSSKZOUT) D
- .K PSSKZOK,PSSKZDAT,PSSKZLIP,PSSKZZR,PSSKZNDF,PSSKZDF,PSSKZDT1,PSSKZLP1,PSSKZNFL,PSSKZMSG,PSSKZSTR,PSSKZUNT,PSSKZUNZ,PSSKZAPU,PSSKZ1,PSSKZ2,PSSKZ3,PSSKZND1,PSSKZND3
- .S PSSKZZR=$G(^PSDRUG(PSSKZIEN,0))
- .S PSSKZSTR=$P($G(^PSDRUG(PSSKZIEN,"DOS")),"^"),PSSKZUNT=$P($G(^PSDRUG(PSSKZIEN,"DOS")),"^",2)
- .S PSSKZSTR=$S($E(PSSKZSTR,1)=".":"0"_PSSKZSTR,1:PSSKZSTR)
- .I PSSKZUNT S PSSKZUNZ=$P($G(^PS(50.607,+PSSKZUNT,0)),"^")
- .S PSSKZNFL=$S($P(PSSKZZR,"^",9):1,1:0),PSSKZMSG=$P(PSSKZZR,"^",10)
- .S PSSKZAPU=$P($G(^PSDRUG(PSSKZIEN,2)),"^",3)
- .S PSSKZND1=$P($G(^PSDRUG(PSSKZIEN,"ND")),"^"),PSSKZND3=$P($G(^PSDRUG(PSSKZIEN,"ND")),"^",3)
- .S PSSKZOK=$$TEST
- .I 'PSSKZOK Q
- .S PSSKZDAT=0 F PSSKZLIP=0:0 S PSSKZLIP=$O(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLIP)) Q:'PSSKZLIP!(PSSKZDAT) I $P($G(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLIP,0)),"^")'="" S PSSKZDAT=1
- .I 'PSSKZDAT Q
- .S PSSKZDT1=0 I PSSKZTPE="O" F PSSKZLP1=0:0 S PSSKZLP1=$O(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1)) Q:'PSSKZLP1!(PSSKZDT1) I $P($G(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1,0)),"^")'="" D
- ..I '$P($G(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1,0)),"^",5)!($P($G(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1,0)),"^",6)="") S PSSKZDT1=1
- .I PSSKZTPE="O",'PSSKZDT1 Q
- .S PSSKZNOF=1
- .W !!!,"("_PSSKZIEN_")",?19,$P(PSSKZZR,"^")_$S(PSSKZNFL:" *N/F*",1:"")
- .I ($Y+5)>IOSL D HD Q:PSSKZOUT
- .I PSSKZMSG'="" W !?12,PSSKZMSG
- .I ($Y+5)>IOSL D HD Q:PSSKZOUT
- .W !?12,"Strength: "_PSSKZSTR W ?43,"Units: " I $G(PSSKZUNZ)'="" W $G(PSSKZUNZ)
- .I $G(PSSKZUNZ)'="",$L(PSSKZUNZ)>15 W !
- .;I ($Y+5)>IOSL D HD Q:PSSKZOUT
- .W ?66,"Application Package: "_PSSKZAPU
- .I ($Y+5)>IOSL D HD Q:PSSKZOUT
- .S PSSKZ3=0 W !?4,"Local Possible Dosages: " F PSSKZ1=0:0 S PSSKZ1=$O(^PSDRUG(PSSKZIEN,"DOS2",PSSKZ1)) Q:'PSSKZ1!(PSSKZOUT) D
- ..S PSSKZ2=$G(^PSDRUG(PSSKZIEN,"DOS2",PSSKZ1,0))
- ..I $P(PSSKZ2,"^")="" Q
- ..I $P(PSSKZ2,"^",5),$P(PSSKZ2,"^",6)'="",PSSKZTPE="O" Q
- ..S PSSKZ3=1
- ..I ($Y+5)>IOSL D HD Q:PSSKZOUT
- ..W !?6,$P(PSSKZ2,"^")
- ..I ($Y+5)>IOSL D HD Q:PSSKZOUT
- ..K PSSKZLD5,PSSKZLD6,PSSKZLD7
- ..S PSSKZLD5=$P(PSSKZ2,"^",5),PSSKZLD6=$P(PSSKZ2,"^",6)
- ..S PSSKZLD7=$S($E(PSSKZLD6,1)=".":"0"_PSSKZLD6,1:PSSKZLD6)
- ..W !?6,"Numeric Dose: "_PSSKZLD7,?46,"Dose Unit: "_$S($G(PSSKZLD5):$P($G(^PS(51.24,+PSSKZLD5,0)),"^"),1:""),?92,"Package: "_$P(PSSKZ2,"^",2)
- ..I ($Y+5)>IOSL D HD Q:PSSKZOUT
- .Q:PSSKZOUT
- .I 'PSSKZ3 W "(None)"
- .I ($Y+5)>IOSL D HD Q:PSSKZOUT
- .K PSSKZNN1,PSSKZNN2
- .I 'PSSKZND1!('PSSKZND3) Q
- .S PSSKZNN1=$$PROD0^PSNAPIS(PSSKZND1,PSSKZND3)
- .S PSSKZNN2=$S($E($P(PSSKZNN1,"^",3),1)=".":"0"_$P(PSSKZNN1,"^",3),1:$P(PSSKZNN1,"^",3))
- .I PSSKZSTR'="",PSSKZNN2'="",PSSKZNN2'=PSSKZSTR W !?3,"Note: Strength of "_PSSKZSTR_" does not match NDF strength of "_PSSKZNN2_"."
- .I ($Y+5)>IOSL D HD Q:PSSKZOUT
- .W !?3,"VA PRODUCT MATCH: "_$P(PSSKZNN1,"^")
- .I ($Y+5)>IOSL D HD Q:PSSKZOUT
- ;
- END ;
- I '$G(PSSKZOUT),PSSKZTPE="O",'$G(PSSKZNOF) W !!,"No local possible dosage missing data found.",!
- I PSSKZDEV="P" W !!,"End of Report.",!
- I '$G(PSSKZOUT),PSSKZDEV="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- I PSSKZDEV="C" W !
- E W @IOF
- K PSSKZTPE
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- ;
- HD ;Report Header
- I PSSKZDEV="C",PSSKZCT'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR I 'Y S PSSKZOUT=1 Q
- W @IOF
- I PSSKZTPE="A" W !,"Local Possible Dosages Report (All)"
- I PSSKZTPE="O" W !,"Local Possible Dosages Report (Missing Data Only)"
- W ?118,"PAGE: "_PSSKZCT,!,PSSKZLIN,! S PSSKZCT=PSSKZCT+1
- Q
- ;
- ;
- MESS ;
- W !!,"Nothing queued to print.",!
- Q
- ;
- ;
- TEST() ;Test to see if Drug meets criteria
- ;No need to have Local Possible Dose check here, you have it right after calling this at top
- I 'PSSKZND3!('PSSKZND1) Q 0
- I $P($G(^PSDRUG(PSSKZIEN,"I")),"^"),$P($G(^PSDRUG(PSSKZIEN,"I")),"^")<DT Q 0
- N PSSKZDOV
- S PSSKZDOV=""
- I PSSKZND1,PSSKZND3,$T(OVRIDE^PSNAPIS)]"" S PSSKZDOV=$$OVRIDE^PSNAPIS(PSSKZND1,PSSKZND3)
- I $P(PSSKZZR,"^",3)["S"!($E($P(PSSKZZR,"^",2),1,2)="XA") Q 0
- K PSSKZDF
- I PSSKZND1,PSSKZND3 S PSSKZNDF=$$DFSU^PSNAPIS(PSSKZND1,PSSKZND3) S PSSKZDF=$P(PSSKZNDF,"^")
- I $G(PSSKZDF)'>0,$P($G(^PSDRUG(PSSKZIEN,2)),"^") S PSSKZDF=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSKZIEN,2)),"^"),0)),"^",2)
- I PSSKZDOV=""!('$G(PSSKZDF))!($P($G(^PS(50.606,+$G(PSSKZDF),1)),"^")="") Q 1
- I $P($G(^PS(50.606,+$G(PSSKZDF),1)),"^"),'PSSKZDOV Q 0
- I '$P($G(^PS(50.606,+$G(PSSKZDF),1)),"^"),PSSKZDOV Q 0
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSLDOSE 7337 printed Mar 13, 2025@21:37:24 Page 2
- PSSLDOSE ;BIR/RTR-Local Possible Dosages Report ;06/22/07
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
- +2 ;
- +3 ;External reference to PS(50.607 supported by DBIA 2221
- +4 ;
- EN ;
- +1 WRITE !!,"This report will print Local Possible Dosage information only for Drugs for"
- +2 WRITE !,"which Dosage Checks can be performed. Drugs that are inactive, marked and/or"
- +3 WRITE !,"classed as supply items, not matched to NDF or excluded from dosage checks (due"
- +4 WRITE !,"to dosage form or VA Product override) will not be included in this report."
- +5 WRITE !!,"Users will be able to print Local Possible Dosage information for all eligible"
- +6 WRITE !,"drugs or only for drugs with missing data in the Numeric Dose and Dose Unit"
- +7 WRITE !,"fields. These two fields must be populated to perform Dosage Checks for a Local"
- +8 WRITE !,"Possible Dosage selected when placing a Pharmacy order."
- +9 NEW DIR,PSSKZTPE,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
- +10 KILL DIR
- SET DIR(0)="SO^A:ALL LOCAL POSSIBLE DOSAGES;O:ONLY LOCAL POSSIBLE DOSAGE WITH MISSING DATA"
- SET DIR("A")="Enter 'A' for All, 'O' for Only"
- SET DIR("B")="O"
- +11 SET DIR("?")=" "
- SET DIR("?",1)="Enter 'A' to see All Local Possible Dosages, regardless of whether or not the "
- SET DIR("?",2)="associated Numeric Dose and Dose Unit fields are populated. Enter 'O' to see"
- +12 SET DIR("?",3)="only those Local Possible Dosages with missing data in either the Numeric Dose"
- SET DIR("?",4)="or Dose Unit fields. The two fields must be populated if Dosage Checks are"
- +13 SET DIR("?",5)="to be performed when this Local Possible Dosage is selected when placing a"
- SET DIR("?",6)="Pharmacy order."
- +14 DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)!($DATA(DTOUT))
- DO MESS
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- QUIT
- +15 IF Y'="A"
- IF Y'="O"
- DO MESS
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- QUIT
- +16 SET PSSKZTPE=Y
- +17 WRITE !!,"This report is designed for 132 column format!",!
- +18 KILL IOP,%ZIS,POP
- SET %ZIS="QM"
- DO ^%ZIS
- IF $GET(POP)>0
- DO MESS
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,IOP,%ZIS,POP
- QUIT
- +19 IF $DATA(IO("Q"))
- SET ZTRTN="START^PSSLDOSE"
- SET ZTDESC="Local Possible Dosages Report"
- SET ZTSAVE("PSSKZTPE")=""
- DO ^%ZTLOAD
- KILL %ZIS
- WRITE !!,"Report queued to print.",!
- Begin DoDot:1
- +20 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +21 ;
- +22 ;
- START ;Print Local Possible Dosages Report
- +1 USE IO
- +2 NEW PSSKZDEV,PSSKZCT,PSSKZOUT,PSSKZLIN,PSSKZNOF,PSSKZNM,PSSKZIEN,PSSKZOK,PSSKZDAT,PSSKZLIP,PSSKZND1,PSSKZND3,PSSKZZR,PSSKZNDF,PSSKZDF,PSSKZDT1,PSSKZLP1
- +3 NEW PSSKZNFL,PSSKZMSG,PSSKZSTR,PSSKZUNT,PSSKZUNZ,PSSKZAPU,PSSKZ1,PSSKZ2,PSSKZ3,PSSKZLD5,PSSKZLD6,PSSKZLD7,PSSKZNN1,PSSKZNN2
- +4 SET (PSSKZOUT,PSSKZNOF)=0
- SET PSSKZDEV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
- SET PSSKZCT=1
- +5 KILL PSSKZLIN
- SET $PIECE(PSSKZLIN,"-",130)=""
- +6 DO HD
- +7 SET PSSKZNM=""
- FOR
- SET PSSKZNM=$ORDER(^PSDRUG("B",PSSKZNM))
- if PSSKZNM=""!(PSSKZOUT)
- QUIT
- FOR PSSKZIEN=0:0
- SET PSSKZIEN=$ORDER(^PSDRUG("B",PSSKZNM,PSSKZIEN))
- if 'PSSKZIEN!(PSSKZOUT)
- QUIT
- Begin DoDot:1
- +8 KILL PSSKZOK,PSSKZDAT,PSSKZLIP,PSSKZZR,PSSKZNDF,PSSKZDF,PSSKZDT1,PSSKZLP1,PSSKZNFL,PSSKZMSG,PSSKZSTR,PSSKZUNT,PSSKZUNZ,PSSKZAPU,PSSKZ1,PSSKZ2,PSSKZ3,PSSKZND1,PSSKZND3
- +9 SET PSSKZZR=$GET(^PSDRUG(PSSKZIEN,0))
- +10 SET PSSKZSTR=$PIECE($GET(^PSDRUG(PSSKZIEN,"DOS")),"^")
- SET PSSKZUNT=$PIECE($GET(^PSDRUG(PSSKZIEN,"DOS")),"^",2)
- +11 SET PSSKZSTR=$SELECT($EXTRACT(PSSKZSTR,1)=".":"0"_PSSKZSTR,1:PSSKZSTR)
- +12 IF PSSKZUNT
- SET PSSKZUNZ=$PIECE($GET(^PS(50.607,+PSSKZUNT,0)),"^")
- +13 SET PSSKZNFL=$SELECT($PIECE(PSSKZZR,"^",9):1,1:0)
- SET PSSKZMSG=$PIECE(PSSKZZR,"^",10)
- +14 SET PSSKZAPU=$PIECE($GET(^PSDRUG(PSSKZIEN,2)),"^",3)
- +15 SET PSSKZND1=$PIECE($GET(^PSDRUG(PSSKZIEN,"ND")),"^")
- SET PSSKZND3=$PIECE($GET(^PSDRUG(PSSKZIEN,"ND")),"^",3)
- +16 SET PSSKZOK=$$TEST
- +17 IF 'PSSKZOK
- QUIT
- +18 SET PSSKZDAT=0
- FOR PSSKZLIP=0:0
- SET PSSKZLIP=$ORDER(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLIP))
- if 'PSSKZLIP!(PSSKZDAT)
- QUIT
- IF $PIECE($GET(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLIP,0)),"^")'=""
- SET PSSKZDAT=1
- +19 IF 'PSSKZDAT
- QUIT
- +20 SET PSSKZDT1=0
- IF PSSKZTPE="O"
- FOR PSSKZLP1=0:0
- SET PSSKZLP1=$ORDER(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1))
- if 'PSSKZLP1!(PSSKZDT1)
- QUIT
- IF $PIECE($GET(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1,0)),"^")'=""
- Begin DoDot:2
- +21 IF '$PIECE($GET(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1,0)),"^",5)!($PIECE($GET(^PSDRUG(PSSKZIEN,"DOS2",PSSKZLP1,0)),"^",6)="")
- SET PSSKZDT1=1
- End DoDot:2
- +22 IF PSSKZTPE="O"
- IF 'PSSKZDT1
- QUIT
- +23 SET PSSKZNOF=1
- +24 WRITE !!!,"("_PSSKZIEN_")",?19,$PIECE(PSSKZZR,"^")_$SELECT(PSSKZNFL:" *N/F*",1:"")
- +25 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- +26 IF PSSKZMSG'=""
- WRITE !?12,PSSKZMSG
- +27 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- +28 WRITE !?12,"Strength: "_PSSKZSTR
- WRITE ?43,"Units: "
- IF $GET(PSSKZUNZ)'=""
- WRITE $GET(PSSKZUNZ)
- +29 IF $GET(PSSKZUNZ)'=""
- IF $LENGTH(PSSKZUNZ)>15
- WRITE !
- +30 ;I ($Y+5)>IOSL D HD Q:PSSKZOUT
- +31 WRITE ?66,"Application Package: "_PSSKZAPU
- +32 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- +33 SET PSSKZ3=0
- WRITE !?4,"Local Possible Dosages: "
- FOR PSSKZ1=0:0
- SET PSSKZ1=$ORDER(^PSDRUG(PSSKZIEN,"DOS2",PSSKZ1))
- if 'PSSKZ1!(PSSKZOUT)
- QUIT
- Begin DoDot:2
- +34 SET PSSKZ2=$GET(^PSDRUG(PSSKZIEN,"DOS2",PSSKZ1,0))
- +35 IF $PIECE(PSSKZ2,"^")=""
- QUIT
- +36 IF $PIECE(PSSKZ2,"^",5)
- IF $PIECE(PSSKZ2,"^",6)'=""
- IF PSSKZTPE="O"
- QUIT
- +37 SET PSSKZ3=1
- +38 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- +39 WRITE !?6,$PIECE(PSSKZ2,"^")
- +40 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- +41 KILL PSSKZLD5,PSSKZLD6,PSSKZLD7
- +42 SET PSSKZLD5=$PIECE(PSSKZ2,"^",5)
- SET PSSKZLD6=$PIECE(PSSKZ2,"^",6)
- +43 SET PSSKZLD7=$SELECT($EXTRACT(PSSKZLD6,1)=".":"0"_PSSKZLD6,1:PSSKZLD6)
- +44 WRITE !?6,"Numeric Dose: "_PSSKZLD7,?46,"Dose Unit: "_$SELECT($GET(PSSKZLD5):$PIECE($GET(^PS(51.24,+PSSKZLD5,0)),"^"),1:""),?92,"Package: "_$PIECE(PSSKZ2,"^",2)
- +45 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- End DoDot:2
- +46 if PSSKZOUT
- QUIT
- +47 IF 'PSSKZ3
- WRITE "(None)"
- +48 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- +49 KILL PSSKZNN1,PSSKZNN2
- +50 IF 'PSSKZND1!('PSSKZND3)
- QUIT
- +51 SET PSSKZNN1=$$PROD0^PSNAPIS(PSSKZND1,PSSKZND3)
- +52 SET PSSKZNN2=$SELECT($EXTRACT($PIECE(PSSKZNN1,"^",3),1)=".":"0"_$PIECE(PSSKZNN1,"^",3),1:$PIECE(PSSKZNN1,"^",3))
- +53 IF PSSKZSTR'=""
- IF PSSKZNN2'=""
- IF PSSKZNN2'=PSSKZSTR
- WRITE !?3,"Note: Strength of "_PSSKZSTR_" does not match NDF strength of "_PSSKZNN2_"."
- +54 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- +55 WRITE !?3,"VA PRODUCT MATCH: "_$PIECE(PSSKZNN1,"^")
- +56 IF ($Y+5)>IOSL
- DO HD
- if PSSKZOUT
- QUIT
- End DoDot:1
- +57 ;
- END ;
- +1 IF '$GET(PSSKZOUT)
- IF PSSKZTPE="O"
- IF '$GET(PSSKZNOF)
- WRITE !!,"No local possible dosage missing data found.",!
- +2 IF PSSKZDEV="P"
- WRITE !!,"End of Report.",!
- +3 IF '$GET(PSSKZOUT)
- IF PSSKZDEV="C"
- WRITE !!,"End of Report."
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +4 IF PSSKZDEV="C"
- WRITE !
- +5 IF '$TEST
- WRITE @IOF
- +6 KILL PSSKZTPE
- +7 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +8 QUIT
- +9 ;
- +10 ;
- HD ;Report Header
- +1 IF PSSKZDEV="C"
- IF PSSKZCT'=1
- WRITE !
- KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue, '^' to exit"
- DO ^DIR
- IF 'Y
- SET PSSKZOUT=1
- QUIT
- +2 WRITE @IOF
- +3 IF PSSKZTPE="A"
- WRITE !,"Local Possible Dosages Report (All)"
- +4 IF PSSKZTPE="O"
- WRITE !,"Local Possible Dosages Report (Missing Data Only)"
- +5 WRITE ?118,"PAGE: "_PSSKZCT,!,PSSKZLIN,!
- SET PSSKZCT=PSSKZCT+1
- +6 QUIT
- +7 ;
- +8 ;
- MESS ;
- +1 WRITE !!,"Nothing queued to print.",!
- +2 QUIT
- +3 ;
- +4 ;
- TEST() ;Test to see if Drug meets criteria
- +1 ;No need to have Local Possible Dose check here, you have it right after calling this at top
- +2 IF 'PSSKZND3!('PSSKZND1)
- QUIT 0
- +3 IF $PIECE($GET(^PSDRUG(PSSKZIEN,"I")),"^")
- IF $PIECE($GET(^PSDRUG(PSSKZIEN,"I")),"^")<DT
- QUIT 0
- +4 NEW PSSKZDOV
- +5 SET PSSKZDOV=""
- +6 IF PSSKZND1
- IF PSSKZND3
- IF $TEXT(OVRIDE^PSNAPIS)]""
- SET PSSKZDOV=$$OVRIDE^PSNAPIS(PSSKZND1,PSSKZND3)
- +7 IF $PIECE(PSSKZZR,"^",3)["S"!($EXTRACT($PIECE(PSSKZZR,"^",2),1,2)="XA")
- QUIT 0
- +8 KILL PSSKZDF
- +9 IF PSSKZND1
- IF PSSKZND3
- SET PSSKZNDF=$$DFSU^PSNAPIS(PSSKZND1,PSSKZND3)
- SET PSSKZDF=$PIECE(PSSKZNDF,"^")
- +10 IF $GET(PSSKZDF)'>0
- IF $PIECE($GET(^PSDRUG(PSSKZIEN,2)),"^")
- SET PSSKZDF=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSKZIEN,2)),"^"),0)),"^",2)
- +11 IF PSSKZDOV=""!('$GET(PSSKZDF))!($PIECE($GET(^PS(50.606,+$GET(PSSKZDF),1)),"^")="")
- QUIT 1
- +12 IF $PIECE($GET(^PS(50.606,+$GET(PSSKZDF),1)),"^")
- IF 'PSSKZDOV
- QUIT 0
- +13 IF '$PIECE($GET(^PS(50.606,+$GET(PSSKZDF),1)),"^")
- IF PSSKZDOV
- QUIT 0
- +14 QUIT 1
