PSXBPSR1 ;BHAM ISC/MFR - CMOP/ECME ACTIVITY REPORT - continuation ;09/01/2006
;;2.0;CMOP;**65**;11 Apr 97;Build 31
;External reference to ^PSRX( supported by IA #1221
;External reference to ^PS(59 supported by IA #1976
;External reference to ^PSOBPSUT supported by IA #4701
;External reference to ^BPSUTIL supported by IA #4410
;External reference to ^IBNCPDPI supported by IA #4729
;
;
; Enter Date Range
;
; Return Value -> P1^P2
;
; where P1 = From Date
; = ^ Exit
; P2 = To Date
; = blank for Exit
;
SELDATE() N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
S VAL=""
S DIR(0)="DA^^W:Y'=U "" (""_$$FMTE^XLFDT(Y)_"")"""
S DIR("A")="ENTER BEGINNING TRANSMISSION DATE: "
D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^"
;
I VAL="" D
.S $P(VAL,U)=Y
.S DIR(0)="DA^"_VAL_"^W:Y'=U "" (""_$$FMTE^XLFDT(Y)_"")"""
.S DIR("A")="ENTER ENDING TRANSMISSION DATE: "
.D ^DIR
.;
.;Check for "^", timeout, or blank entry
.I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q
.;
.;Define Entry
.S $P(VAL,U,2)=Y
;
Q VAL
;
;Select Divisions
;
; Returns Arrays -> DIVNM("names of divisions") = selection number
; DIVDA("iens of divisions") = name of division
SELDIV N DIR,DIV,DIVX,DIRUT,DUOUT,DTOUT,I,X,Y
W !!,"SELECTION OF DIVISION(S)",!
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
S I=I-1
K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
;
D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^") K DIVNM Q
;
;All Divisions
I Y="A" D ALL Q
;
;Select Divisions
I Y="S" D SELECT(I),ALL
Q
;
;Select which divisions to display
SELECT(I) N C,DIR,DIVX,DIRUT,DUOUT,DTOUT,X,Y
F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^")!('+Y) K DIVNM Q
;
M DIVX=DIVNM K DIVNM
F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
Q
;
SELTYPE() ; set Summary or Detail report type
N DIR
S DIR(0)="S^S:Summary;D:Detail"
S DIR("A")="Display (S)ummary or (D)etail format"
S DIR("B")="Detail"
D ^DIR
Q $S($G(Y)="S":Y,$G(Y)="D":Y,1:"^")
;;
SELPATS(ARRAY) ; select Patient(s)
N X,Y,DIC,RESULT
W !,"You may select a single or multiple PATIENTS,"
W !,"or enter ^ALL to select all PATIENTS."
S RESULT=0
S Y=0
S DIC="^DPT("
S DIC(0)="AEM"
F Q:Y=-1 D
.D ^DIC
.S Y=$P(Y,"^")
.S ARRAY(Y)=X
.S:Y>0 RESULT=1
S:ARRAY(-1)="^ALL" RESULT=1
Q RESULT
;;
;Display selected divisions
ALL N DA,DIR,DIV,DIRUT,DUOUT,DTOUT,X,Y
Q:'$D(DIVNM)
W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES" D ^DIR
K DIR
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)
;
;Check for "^", timeout, or non-yes entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)'=1) K DIVNM
Q
;
; Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL
;
; Input Variable -> DFLT = 3 NOT RELEASED
; 2 RELEASED
; 1 ALL
;
; Return Value -> 3 = NOT RELEASED
; 2 = RELEASED
; 1 = ALL
; ^ = Exit
;
SELRLNRL(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DFLT=$S($G(DFLT)=1:"ALL",$G(DFLT)=3:"NOT RELEASED",1:"RELEASED")
S DIR(0)="S^R:RELEASED;N:NOT RELEASED;A:ALL"
S DIR("A")="Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL",DIR("B")=DFLT
D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^"
;
S Y=$S(Y="A":1,Y="R":2,Y="N":3,1:Y)
;
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXBPSR1 4035 printed Dec 13, 2024@01:43:34 Page 2
PSXBPSR1 ;BHAM ISC/MFR - CMOP/ECME ACTIVITY REPORT - continuation ;09/01/2006
+1 ;;2.0;CMOP;**65**;11 Apr 97;Build 31
+2 ;External reference to ^PSRX( supported by IA #1221
+3 ;External reference to ^PS(59 supported by IA #1976
+4 ;External reference to ^PSOBPSUT supported by IA #4701
+5 ;External reference to ^BPSUTIL supported by IA #4410
+6 ;External reference to ^IBNCPDPI supported by IA #4729
+7 ;
+8 ;
+9 ; Enter Date Range
+10 ;
+11 ; Return Value -> P1^P2
+12 ;
+13 ; where P1 = From Date
+14 ; = ^ Exit
+15 ; P2 = To Date
+16 ; = blank for Exit
+17 ;
SELDATE() NEW DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
+1 SET VAL=""
+2 SET DIR(0)="DA^^W:Y'=U "" (""_$$FMTE^XLFDT(Y)_"")"""
+3 SET DIR("A")="ENTER BEGINNING TRANSMISSION DATE: "
+4 DO ^DIR
+5 ;
+6 ;Check for "^", timeout, or blank entry
+7 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET VAL="^"
+8 ;
+9 IF VAL=""
Begin DoDot:1
+10 SET $PIECE(VAL,U)=Y
+11 SET DIR(0)="DA^"_VAL_"^W:Y'=U "" (""_$$FMTE^XLFDT(Y)_"")"""
+12 SET DIR("A")="ENTER ENDING TRANSMISSION DATE: "
+13 DO ^DIR
+14 ;
+15 ;Check for "^", timeout, or blank entry
+16 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET VAL="^"
QUIT
+17 ;
+18 ;Define Entry
+19 SET $PIECE(VAL,U,2)=Y
End DoDot:1
+20 ;
+21 QUIT VAL
+22 ;
+23 ;Select Divisions
+24 ;
+25 ; Returns Arrays -> DIVNM("names of divisions") = selection number
+26 ; DIVDA("iens of divisions") = name of division
SELDIV NEW DIR,DIV,DIVX,DIRUT,DUOUT,DTOUT,I,X,Y
+1 WRITE !!,"SELECTION OF DIVISION(S)",!
+2 SET DIV=""
FOR I=1:1
SET DIV=$ORDER(^PS(59,"B",DIV))
if DIV=""
QUIT
SET DIVNM(I)=DIV
SET DIVNM(DIV)=I
SET DIVDA=$ORDER(^PS(59,"B",DIV,0))
SET DIVNM(I,"I")=DIVDA
+3 SET I=I-1
+4 KILL DIR
SET DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
+5 ;
+6 DO ^DIR
+7 ;
+8 ;Check for "^", timeout, or blank entry
+9 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(Y)="^")
KILL DIVNM
QUIT
+10 ;
+11 ;All Divisions
+12 IF Y="A"
DO ALL
QUIT
+13 ;
+14 ;Select Divisions
+15 IF Y="S"
DO SELECT(I)
DO ALL
+16 QUIT
+17 ;
+18 ;Select which divisions to display
SELECT(I) NEW C,DIR,DIVX,DIRUT,DUOUT,DTOUT,X,Y
+1 FOR C=1:1:I
SET DIR("A",C)=C_" "_DIVNM(C)
+2 SET DIR(0)="LO^1:"_I
SET DIR("A")="Select Division(s) "
+3 DO ^DIR
+4 ;
+5 ;Check for "^", timeout, or blank entry
+6 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(Y)="^")!('+Y)
KILL DIVNM
QUIT
+7 ;
+8 MERGE DIVX=DIVNM
KILL DIVNM
+9 FOR I=1:1
SET X=$PIECE(Y,",",I)
if 'X
QUIT
MERGE DIVNM(X)=DIVX(X)
SET DIVNM=DIVX(X)
SET DIVNM(DIVNM)=X
+10 QUIT
+11 ;
SELTYPE() ; set Summary or Detail report type
+1 NEW DIR
+2 SET DIR(0)="S^S:Summary;D:Detail"
+3 SET DIR("A")="Display (S)ummary or (D)etail format"
+4 SET DIR("B")="Detail"
+5 DO ^DIR
+6 QUIT $SELECT($GET(Y)="S":Y,$GET(Y)="D":Y,1:"^")
+7 ;;
SELPATS(ARRAY) ; select Patient(s)
+1 NEW X,Y,DIC,RESULT
+2 WRITE !,"You may select a single or multiple PATIENTS,"
+3 WRITE !,"or enter ^ALL to select all PATIENTS."
+4 SET RESULT=0
+5 SET Y=0
+6 SET DIC="^DPT("
+7 SET DIC(0)="AEM"
+8 FOR
if Y=-1
QUIT
Begin DoDot:1
+9 DO ^DIC
+10 SET Y=$PIECE(Y,"^")
+11 SET ARRAY(Y)=X
+12 if Y>0
SET RESULT=1
End DoDot:1
+13 if ARRAY(-1)="^ALL"
SET RESULT=1
+14 QUIT RESULT
+15 ;;
+16 ;Display selected divisions
ALL NEW DA,DIR,DIV,DIRUT,DUOUT,DTOUT,X,Y
+1 if '$DATA(DIVNM)
QUIT
+2 WRITE !!,"You have selected:",!
SET DIV=0
FOR
SET DIV=$ORDER(DIVNM(DIV))
if 'DIV
QUIT
WRITE !,DIV,?5,DIVNM(DIV)
+3 SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="YES"
DO ^DIR
+4 KILL DIR
+5 IF Y=1
SET DIV=0
FOR
SET DIV=$ORDER(DIVNM(DIV))
if 'DIV
QUIT
SET DA=DIVNM(DIV,"I")
SET DIVDA(DA)=DIVNM(DIV)
KILL DIVNM(DIV)
+6 ;
+7 ;Check for "^", timeout, or non-yes entry
+8 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(Y)'=1)
KILL DIVNM
+9 QUIT
+10 ;
+11 ; Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL
+12 ;
+13 ; Input Variable -> DFLT = 3 NOT RELEASED
+14 ; 2 RELEASED
+15 ; 1 ALL
+16 ;
+17 ; Return Value -> 3 = NOT RELEASED
+18 ; 2 = RELEASED
+19 ; 1 = ALL
+20 ; ^ = Exit
+21 ;
SELRLNRL(DFLT) NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+1 SET DFLT=$SELECT($GET(DFLT)=1:"ALL",$GET(DFLT)=3:"NOT RELEASED",1:"RELEASED")
+2 SET DIR(0)="S^R:RELEASED;N:NOT RELEASED;A:ALL"
+3 SET DIR("A")="Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL"
SET DIR("B")=DFLT
+4 DO ^DIR
+5 ;
+6 ;Check for "^", timeout, or blank entry
+7 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET Y="^"
+8 ;
+9 SET Y=$SELECT(Y="A":1,Y="R":2,Y="N":3,1:Y)
+10 ;
+11 QUIT Y
