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

PSBOXA.m

Go to the documentation of this file. 
  1. PSBOXA ;BIRMINGHAM/EFC-MEDICATION LOG ;Mar 2004
  1.  ;;3.0;BAR CODE MED ADMIN;**13,81**;Mar 2004;Build 6
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference/IA
  1.  ;
  1.  ; File 4/10090
  1.  ;
  1.  ;
  1.  ; Entry Point -   Report OPTION used by PSB MANAGER key holders to locate
  1.  ;                "UNKNOWN" Action Status entries in the BCMA Medication Log File.
  1.  ;
  1. EN ;  UNKNOWN Action Status Report - creation!
  1.  ;
  1.  S PSBDTST=+$P(PSBRPT(.1),U,6)
  1.  S PSBDTSP=+$P(PSBRPT(.1),U,8)
  1.  D NOW^%DTC S Y=% D DD^%DT S PSBDTTM=Y
  1.  S PSBLIST=""
  1.  S (PSBPGNUM,PSBLNTOT,PSBTOT,PSBX1)=""
  1.  F  S PSBX1=$O(^PSB(53.79,"AADT",PSBX1)) Q:PSBX1=""  D
  1.  .S PSBX2=$$FMADD^XLFDT(PSBDTST,,,,-.1) F  S PSBX2=$O(^PSB(53.79,"AADT",PSBX1,PSBX2)) Q:(PSBX2>$$FMADD^XLFDT(PSBDTSP,,23.9999))!(+PSBX2=0)  D
  1.  ..S PSBX3="" F  S PSBX3=$O(^PSB(53.79,"AADT",PSBX1,PSBX2,PSBX3)) Q:+PSBX3=0  D
  1.  ...Q:('$D(^PSB(53.79,PSBX3,0)))!$D(PSBLIST(PSBX3))
  1.  ...I $P(^PSB(53.79,PSBX3,0),U,9)="" I $$GET1^DIQ(4,$P(PSBRPT(0),U,4)_",",.01)=$$GET1^DIQ(4,$P(^PSB(53.79,PSBX3,0),U,3)_",",.01) D
  1.  ....L +^PSB(53.79,PSBX3):1 I  L -^PSB(53.79,PSBX3) S PSBTOT=PSBTOT+1,PSBLIST(PSBX3)=""
  1.  I +PSBTOT=0 K PSBLIST
  1.  S Y=PSBDTST D DD^%DT S Y1=Y S Y=PSBDTSP D DD^%DT S Y2=Y
  1.  D BLDRPT
  1.  D WRTRPT
  1.  Q
  1.  ;
  1. BLDRPT ;
  1.  ;
  1.  K PSBOUTP
  1.  S (PSBPGNUM,PSBX1)=""
  1.  I '$D(PSBLIST) D  Q
  1.  .S PSBPGNUM=1
  1.  .S PSBOUTP(0,14)="W !!,""<<<< NO """"UNKNOWN ACTION STATUS"""" ENTRIES FOUND FOR THIS DATE RANGE >>>>"",!!"
  1.  S PSBPGNUM=1,PSBTOT1=0
  1.  F  S PSBX1=$O(PSBLIST(PSBX1))  Q:+PSBX1=0  D
  1.  .S PSBTOT1=PSBTOT1+1
  1.  .D CLEAN^PSBVT,PSJ1^PSBVT($$GET1^DIQ(53.79,PSBX1_",",.01,"I"),$$GET1^DIQ(53.79,PSBX1_",",.11))
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W """_PSBTOT1_".)"",!,?5,""Action Status...: "_$S($$GET1^DIQ(53.79,PSBX1_",",.09)']"":"*UNKNOWN*",1:$$GET1^DIQ(53.79,PSBX1_",",.09))_""""
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Patient.........: ("_$S(DUZ("AG")="I":$$HRN^AUPNPAT(PSBDFN,DUZ(2)),1:$$GET1^DIQ(2,PSBDFN_",",.09))_") "_$$GET1^DIQ(2,PSBDFN_",",.01)_"""" ;add code for IHS, PSB*3*81
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Ward/Bed........: "_$$GET1^DIQ(2,PSBDFN_",",.1)_$S($$GET1^DIQ(2,PSBDFN_",",.101)']"":"",1:"/"_$$GET1^DIQ(2,PSBDFN_",",.101))_""""
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Order Number....: "_PSBONX_""""
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Orderable Item..: "_PSBOITX_""""
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Schedule........: "_PSBSCH_""""
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Scheduled Adm Tm: "_$S($$GET1^DIQ(53.79,PSBX1_",",.13)']"":"AS NEEDED",1:$$GET1^DIQ(53.79,PSBX1_",",.13))_""""
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created Dt/Tm...: "_$$GET1^DIQ(53.79,PSBX1_",",.06)_""""
  1.  .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created By......: ("_$$GET1^DIQ(53.79,PSBX1_",",.07,"I")_") "_$$GET1^DIQ(53.79,PSBX1_",",.07)_""""
  1.  .S PSBOUTP($$PGTOT(3),PSBLNTOT)="W !,$TR($J("""",IOM),"" "",""-""),!!"
  1.  Q
  1.  ;
  1. WRTRPT ;  Actually "WRITE" the report to output device
  1.  ;
  1.  I $O(PSBOUTP(""),-1)<1 D  Q
  1.  .D HDR
  1.  .X PSBOUTP($O(PSBOUTP(""),-1),14)
  1.  .D FTR
  1.  S PSBPGNUM=1
  1.  D HDR
  1.  S PSBX1="" F  S PSBX1=$O(PSBOUTP(PSBX1)) Q:PSBX1=""  D
  1.  .I PSBPGNUM'=PSBX1 D FTR S PSBPGNUM=PSBX1 D HDR
  1.  .S PSBX2="" F  S PSBX2=$O(PSBOUTP(PSBX1,PSBX2)) Q:PSBX2=""  D
  1.  ..X PSBOUTP(PSBX1,PSBX2)
  1.  D FTR
  1.  Q
  1.  ;
  1. HDR ;  Create Report Header
  1.  ;
  1.  ;
  1.  ;   BAR CODE MEDICATION ADMINISTRATION (BCMA) UNKNOWN ACTION STATUS REPORT
  1.  ;   Date/Time: NOW
  1.  ;   Date Range:   Y1  to  Y2   (inculsive)
  1.  ;   
  1.  ;   
  1.  ;   This is a report of entries, created within the given date range, in the
  1.  ;   BCMA Medication Log File with UNKNOWN Action Status data.
  1.  ;   These entries may be corrected via the BCMA GUI "Edit Med Log".   
  1.  ;   
  1.  ;----------------------------------------------------------------
  1.  ;
  1.  W:$Y>1 @IOF
  1.  W:$X>1 !
  1.  S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))
  1.  S PSBPGRM=IOM-($L(PSBPG)+5)
  1.  I $P(PSBRPT(0),U,4)="" S $P(PSBRPT(0),U,4)=DUZ(2)
  1.  S PSBDIVN="Division: "_$$GET1^DIQ(4,$P(PSBRPT(0),U,4)_",",.01)
  1.  W !!,"BCMA UNKNOWN ACTION STATUS REPORT" W ?PSBPGRM,PSBPG
  1.  W !,"Date/Time: "_PSBDTTM,!,"Report Date Range:  Start Date: "_Y1_"   Stop Date: "_Y2
  1.  W !,PSBDIVN,?(IOM-($L("Total *UNKNOWN* entries found: "_+PSBTOT)+5)),"Total *UNKNOWN* entries found: "_+PSBTOT
  1.  W !!,?5,"This is a report of entries, created within the given date range,"
  1.  W !,?5,"in the BCMA Medication Log File with UNKNOWN Action Status data."
  1.  W !,?5,"These entries can be corrected using the BCMA GUI ""Edit Med Log""."
  1.  W !!,$TR($J("",IOM)," ","="),!!
  1.  ;
  1.  Q
  1.  ;
  1. FTR ;  Create Report Footer
  1.  ;
  1.  I (IOSL<100) F  Q:$Y>(IOSL-7)  W !
  1.  W !,$TR($J("",IOM)," ","="),!
  1.  W !,PSBDTTM,!,"BCMA UNKNOWN ACTION STATUS REPORT - footer -"
  1.  W ?PSBPGRM,PSBPG,!
  1.  Q
  1.  ;
  1. PGTOT(X) ;Keep track of lines and PAGE Number...
  1.  ;
  1.  S:'$D(X) PSBLNTOT=PSBLNTOT+1
  1.  S:$D(X) PSBLNTOT=PSBLNTOT+X
  1.  I PSBPGNUM=1,(PSBLNTOT=1) S PSBLNTOT=14 S PSBMORE=PSBLNTOT+12 Q PSBPGNUM
  1.  I PSBLNTOT=PSBMORE D
  1.  .S PSBMORE=PSBLNTOT+12
  1.  .I PSBMORE>(IOSL-7) S PSBPGNUM=PSBPGNUM+1,PSBLNTOT=14 S PSBMORE=PSBLNTOT+12
  1.  Q PSBPGNUM