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

PSXBPSR1.m

Go to the documentation of this file. 
  1. PSXBPSR1 ;BHAM ISC/MFR - CMOP/ECME ACTIVITY REPORT - continuation ;09/01/2006
  1.  ;;2.0;CMOP;**65**;11 Apr 97;Build 31
  1.  ;External reference to ^PSRX( supported by IA #1221
  1.  ;External reference to ^PS(59 supported by IA #1976
  1.  ;External reference to ^PSOBPSUT supported by IA #4701
  1.  ;External reference to ^BPSUTIL supported by IA #4410
  1.  ;External reference to ^IBNCPDPI supported by IA #4729
  1.  ; 
  1.  ;
  1.  ; Enter Date Range
  1.  ;
  1.  ; Return Value -> P1^P2
  1.  ; 
  1.  ;           where P1 = From Date
  1.  ;                    = ^ Exit
  1.  ;                 P2 = To Date
  1.  ;                    = blank for Exit
  1.  ;                 
  1. SELDATE() N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
  1.  S VAL=""
  1.  S DIR(0)="DA^^W:Y'=U "" (""_$$FMTE^XLFDT(Y)_"")"""
  1.  S DIR("A")="ENTER BEGINNING TRANSMISSION DATE: "
  1.  D ^DIR
  1.  ;
  1.  ;Check for "^", timeout, or blank entry
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^"
  1.  ;
  1.  I VAL="" D
  1.  .S $P(VAL,U)=Y
  1.  .S DIR(0)="DA^"_VAL_"^W:Y'=U "" (""_$$FMTE^XLFDT(Y)_"")"""
  1.  .S DIR("A")="ENTER ENDING TRANSMISSION DATE: "
  1.  .D ^DIR
  1.  .;
  1.  .;Check for "^", timeout, or blank entry
  1.  .I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q
  1.  .;
  1.  .;Define Entry
  1.  .S $P(VAL,U,2)=Y
  1.  ;
  1.  Q VAL
  1.  ;
  1.  ;Select Divisions
  1.  ;
  1.  ; Returns Arrays -> DIVNM("names of divisions") = selection number
  1.  ;                   DIVDA("iens of divisions") = name of division
  1. SELDIV N DIR,DIV,DIVX,DIRUT,DUOUT,DTOUT,I,X,Y
  1.  W !!,"SELECTION OF DIVISION(S)",!
  1.  S DIV="" F I=1:1 S DIV=$O(^PS(59,"B",DIV)) Q:DIV=""  S DIVNM(I)=DIV,DIVNM(DIV)=I,DIVDA=$O(^PS(59,"B",DIV,0)),DIVNM(I,"I")=DIVDA
  1.  S I=I-1
  1.  K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
  1.  ;
  1.  D ^DIR
  1.  ;
  1.  ;Check for "^", timeout, or blank entry
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^") K DIVNM Q
  1.  ;
  1.  ;All Divisions
  1.  I Y="A" D ALL Q
  1.  ;
  1.  ;Select Divisions
  1.  I Y="S" D SELECT(I),ALL
  1.  Q
  1.  ;
  1.  ;Select which divisions to display
  1. SELECT(I) N C,DIR,DIVX,DIRUT,DUOUT,DTOUT,X,Y
  1.  F C=1:1:I S DIR("A",C)=C_"    "_DIVNM(C)
  1.  S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
  1.  D ^DIR
  1.  ;
  1.  ;Check for "^", timeout, or blank entry
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^")!('+Y) K DIVNM Q
  1.  ;
  1.  M DIVX=DIVNM K DIVNM
  1.  F I=1:1 S X=$P(Y,",",I) Q:'X  M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
  1.  Q
  1.  ;
  1. SELTYPE() ; set Summary or Detail report type
  1.  N DIR
  1.  S DIR(0)="S^S:Summary;D:Detail"
  1.  S DIR("A")="Display (S)ummary or (D)etail format"
  1.  S DIR("B")="Detail"
  1.  D ^DIR
  1.  Q $S($G(Y)="S":Y,$G(Y)="D":Y,1:"^")
  1.  ;;
  1. SELPATS(ARRAY) ; select Patient(s)
  1.  N X,Y,DIC,RESULT
  1.  W !,"You may select a single or multiple PATIENTS,"
  1.  W !,"or enter ^ALL to select all PATIENTS."
  1.  S RESULT=0
  1.  S Y=0
  1.  S DIC="^DPT("
  1.  S DIC(0)="AEM"
  1.  F  Q:Y=-1  D
  1.  .D ^DIC
  1.  .S Y=$P(Y,"^")
  1.  .S ARRAY(Y)=X
  1.  .S:Y>0 RESULT=1
  1.  S:ARRAY(-1)="^ALL" RESULT=1
  1.  Q RESULT
  1.  ;;
  1.  ;Display selected divisions
  1. ALL N DA,DIR,DIV,DIRUT,DUOUT,DTOUT,X,Y
  1.  Q:'$D(DIVNM)
  1.  W !!,"You have selected:",! S DIV=0 F  S DIV=$O(DIVNM(DIV)) Q:'DIV  W !,DIV,?5,DIVNM(DIV)
  1.  S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES" D ^DIR
  1.  K DIR
  1.  I Y=1 S DIV=0 F  S DIV=$O(DIVNM(DIV)) Q:'DIV  S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
  1.  ;
  1.  ;Check for "^", timeout, or non-yes entry
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)'=1) K DIVNM
  1.  Q
  1.  ;
  1.  ; Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL
  1.  ;
  1.  ;    Input Variable -> DFLT = 3 NOT RELEASED
  1.  ;                             2 RELEASED
  1.  ;                             1 ALL
  1.  ;                          
  1.  ;    Return Value ->   3 = NOT RELEASED
  1.  ;                      2 = RELEASED
  1.  ;                      1 = ALL
  1.  ;                      ^ = Exit
  1.  ;
  1. SELRLNRL(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DFLT=$S($G(DFLT)=1:"ALL",$G(DFLT)=3:"NOT RELEASED",1:"RELEASED")
  1.  S DIR(0)="S^R:RELEASED;N:NOT RELEASED;A:ALL"
  1.  S DIR("A")="Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL",DIR("B")=DFLT
  1.  D ^DIR
  1.  ;
  1.  ;Check for "^", timeout, or blank entry
  1.  I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^"
  1.  ;
  1.  S Y=$S(Y="A":1,Y="R":2,Y="N":3,1:Y)
  1.  ;
  1.  Q Y