Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSADRPT

PSSADRPT.m

Go to the documentation of this file.
  1. PSSADRPT ;BIR/RTR-IV ADDITIVE REPORT ;07/15/09
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
  1. ;
  1. REP ;IV Additive report
  1. ;
  1. W !!,"This report displays entries in the IV ADDITIVES (#52.6) File. You can select",!,"to display only entries marked with '1 BAG/DAY' in the ADDITIVE FREQUENCY (#18)"
  1. W !,"Field, or only those entries with nothing entered in the ADDITIVE FREQUENCY",!,"(#18) Field, or all entries can be displayed.",!
  1. N DIR,PSSKFTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
  1. K DIR,Y S DIR(0)="SO^1:Print entries marked as '1 BAG/DAY' for ADDITIVE FREQUENCY;N:Print entries marked as Null for ADDITIVE FREQUENCY;A:Print all IV Additives"
  1. S DIR("B")="A",DIR("A")="Print which IV Additives"
  1. S DIR("?")=" ",DIR("?",1)="Enter '1' to see only those IV Additives that are marked as '1 BAG/DAY' in"
  1. S DIR("?",2)="the ADDITIVE FREQUENCY (#18) Field, enter 'N' to see only those IV Additives"
  1. S DIR("?",3)="with no data entered in the ADDITIVE FREQUENCY (#18) Field, enter 'A' to"
  1. S DIR("?",4)="see all IV Additives, regardless of ADDITIVE FREQUENCY designation."
  1. D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
  1. I Y'="1",Y'="N",Y'="A" D MESS Q
  1. S PSSKFTP=Y
  1. W !!?3,"This report is designed for 80 column format!",!
  1. K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 W !!,"Nothing queued to print.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,IOP,%ZIS,POP Q
  1. I $D(IO("Q")) S ZTRTN="START^PSSADRPT",ZTDESC="IV Additives Report",ZTSAVE("PSSKFTP")="" D ^%ZTLOAD W !!,"Report queued to print.",! D K IOP,%ZIS,POP Q
  1. .K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. ;
  1. U IO G STARTX
  1. START ;
  1. U IO
  1. N DIR,Y,DIRUT,DIROUT,DUOUT,DTOUT,X
  1. STARTX ;
  1. N PSSKFOUT,PSSKFMDV,PSSKFMFD,PSSKFMCT,PSSKFMLN,PSSKFMXX,PSSKFMIN,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3,PSSKFMTP,PSSKFERR,PSSKFERZ,PSSKFERX
  1. S (PSSKFOUT,PSSKFMFD)=0,PSSKFMDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSKFMCT=1
  1. K PSSKFMLN S $P(PSSKFMLN,"-",79)=""
  1. D HD
  1. S PSSKFMXX="" F S PSSKFMXX=$O(^PS(52.6,"B",PSSKFMXX)) Q:PSSKFMXX=""!(PSSKFOUT) D
  1. .F PSSKFMIN=0:0 S PSSKFMIN=$O(^PS(52.6,"B",PSSKFMXX,PSSKFMIN)) Q:'PSSKFMIN!(PSSKFOUT) D
  1. ..K PSSKFMTP,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFML3
  1. ..S PSSKFMTP=PSSKFMIN_","
  1. ..D GETS^DIQ(52.6,PSSKFMTP,".01;1;2;12;15;17;18","IE","PSSKFMAR","PSSKFERR")
  1. ..I PSSKFTP=1,$G(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'=1 Q
  1. ..I PSSKFTP="N",$G(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'="" Q
  1. ..S PSSKFMFD=1
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..W !!?18,"Print Name: "_$G(PSSKFMAR(52.6,PSSKFMTP,.01,"E"))
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..W !?19,"Drug Unit: "_$G(PSSKFMAR(52.6,PSSKFMTP,2,"E"))
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..W !?20,"Synonyms: "
  1. ..S PSSKFMSC=0 F PSSKFMSY=0:0 S PSSKFMSY=$O(^PS(52.6,PSSKFMIN,3,PSSKFMSY)) Q:'PSSKFMSY!(PSSKFOUT) D
  1. ...K PSSKFMSU,PSSKFMSX
  1. ...S PSSKFMSU=PSSKFMSY_","_PSSKFMIN_"," S PSSKFMSX=$$GET1^DIQ(52.63,PSSKFMSU,".01",,,"PSSKFERX")
  1. ...W:PSSKFMSC !?30,$G(PSSKFMSX) W:'PSSKFMSC ?30,$G(PSSKFMSX)
  1. ...S PSSKFMSC=1
  1. ...I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..Q:PSSKFOUT
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..W !?16,"Generic Drug: "_$G(PSSKFMAR(52.6,PSSKFMTP,1,"E"))
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..K PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3
  1. ..S PSSKFML1=$L($G(PSSKFMAR(52.6,PSSKFMTP,15,"E"))),PSSKFMDF=$G(PSSKFMAR(52.6,PSSKFMTP,15,"I"))
  1. ..S PSSKFML2=0 I PSSKFMDF S PSSKFMDZ=PSSKFMDF_"," S PSSKFMDQ=$$GET1^DIQ(50.7,PSSKFMDZ,".02",,,"PSSKFERZ") S PSSKFML2=$L(PSSKFMDQ)
  1. ..S PSSKFML3=PSSKFML1+PSSKFML2
  1. ..W !?5,"Pharmacy Orderable Item: "_$G(PSSKFMAR(52.6,PSSKFMTP,15,"E"))
  1. ..I PSSKFML3<47 W " "_$G(PSSKFMDQ)
  1. ..I PSSKFML3'<47 W !?30,$G(PSSKFMDQ)
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..W !?11,"Inactivation Date: "_$G(PSSKFMAR(52.6,PSSKFMTP,12,"E"))
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..W !,"Used in IV Fluid Order Entry: "_$G(PSSKFMAR(52.6,PSSKFMTP,17,"E"))
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ..W !?10,"Additive Frequency: "_$G(PSSKFMAR(52.6,PSSKFMTP,18,"E"))
  1. ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
  1. ;
  1. END ;End of report
  1. I '$G(PSSKFOUT),'$G(PSSKFMFD) W !!,$S($G(PSSKFTP)=1:"No IV Additives marked as '1 BAG/DAY'.",$G(PSSKFTP)="N":"No IV Additives marked as null.",1:"No IV Additives to print."),!
  1. I $G(PSSKFMDV)="P" W !!,"End of Report.",!
  1. K PSSKFTP
  1. I '$G(PSSKFOUT),$G(PSSKFMDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. I $G(PSSKFMDV)="C" W !
  1. E W @IOF
  1. D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. ;
  1. HD ;Report Header
  1. I $G(PSSKFMDV)="C",$G(PSSKFMCT)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSKFOUT=1 Q
  1. W @IOF W !,$S(PSSKFTP=1:"IV Additives marked as '1 BAG/DAY' for ADDITIVE FREQUENCY",PSSKFTP="N":"IV Additives marked as null for ADDITIVE FREQUENCY",1:"All IV Additives"),?68,"Page: "_$G(PSSKFMCT),!,PSSKFMLN,! S PSSKFMCT=PSSKFMCT+1
  1. Q
  1. ;
  1. MESS ;
  1. W !!,"No Action taken.",!
  1. K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. Q