ADGCRB0 ; IHS/ADC/PDW/ENM - A SHEET driver ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
S DIC="^DPT(",DIC(0)="AQZEM",DIC("A")="Select PATIENT NAME: "
D ^DIC K DIC G:Y'>0 Q S DFN=+Y
MAIN ; -- main
I '$D(DFN)!('$D(^DPT(DFN,0)))!('$D(^AUPNPAT(DFN,0))) Q
S DGDS=0,DGFN=$S($G(DGFN):$G(DGFN),1:0)
;D ASK:DGFN,1:'DGFN I 'DGFN D Q Q
N X S X=$S(DGFN:"ASK",1:1) D @X I 'DGFN D Q Q
D BOT I $D(DIRUT) D Q Q
D NOC I $D(DIRUT) D Q Q
D ZIS I POP D Q Q
I $D(IO("Q")) D QUE,Q Q
D A,Q Q
;
EN(DFN,DGFN) ;EP; -- predefined DFN entry point
D MAIN Q
;
ASK ; -- print?
S DIR(0)="Y",DIR("A")="Do you want to print A sheet",DIR("B")="YES"
D ^DIR S:'Y DGFN=0 Q
;
A U IO F DGZCNT=1:1:DGZC D
. D ^ADGCRB1
. I $D(DGZP) D ^ADGCRB5 D:DGVSDA ^ADGCRB6 ;2nd half (clinical data)
. D:$D(DGZN) ^ADGCRB7 W @IOF ;2nd half (form outline)
Q
;
1 ; -- admission
N I,J,ID,Y,X
I '$D(^DGPM("APCA",DFN)) D Q
. W !?5,"No admissions on file." D PRTOPT^ADGVAR
W !!,"Admission(s)" S I=0
S ID=0 F S ID=$O(^DGPM("ATID1",DFN,ID)) Q:'ID D
. S DGFN=0 F S DGFN=$O(^DGPM("ATID1",DFN,ID,DGFN)) Q:'DGFN D
.. S Y=+^DGPM(DGFN,0),I=I+1,J(I)=DGFN X ^DD("DD") W !?5,I,". ",Y
I I=1 S DGFN=J(I) Q
K DIR S DIR("B")=1,DIR("A")="Select One",DIR(0)="NO^1:"_I D ^DIR K DIR
I Y="" S DGFN=J(1) Q
I $D(DIRUT)!(Y=-1) S DGFN=0 Q
S DGFN=J(+Y)
Q
;
BOT ; -- bottom half form?
Q:$D(DGZP) K DIR,DGZN W !
S DIR("A")="Print bottom half of form"
S DIR("B")=$S($G(DGDS):"NO",1:"YES"),DIR("?")="",DIR(0)="Y"
S DIR("?",1)="Enter YES if you wish to print the headings for"
S DIR("?",2)=" the second half of the A Sheet form,"
S DIR("?",3)="Enter NO to leave second half blank."
D ^DIR S:Y DGZN="" Q
;
NOC ; -- number of copies
K DIR S DIR(0)="N^1:10",DIR("B")=1 S DIR("A")="Print How Many Copies"
D ^DIR S DGZC=Y Q
;
ZIS ; -- select device
S %ZIS="PQ" D ^%ZIS Q
;
QUE ; -- queued output
S ZTRTN="A^ADGCRB0",ZTDESC="PRINT FORM 44-1"
F I="DFN","DGDS","DGFN","DGZC","DGZN","DGZP" S ZTSAVE(I)=""
D ^%ZTLOAD Q
;
Q ; -- cleanup
K DGFN,DGZC,ZTSK,X,Y,DIC,IO("Q"),DGZCNT,%ZIS,DGLIN,DGLIN1,DIR
K DGVSDA,DGPOVN0,DGPOVDA,DGN,DGN0,DGN11,DGN21,DGN33,DGDS,DFN,DGZP
D ^%ZISC,HOME^%ZIS Q
;
DS ;EP; -- day surgery
S DIC="^DPT(",DIC(0)="AQZEM",DIC("A")="Select PATIENT NAME: "
D ^DIC K DIC G:Y'>0 Q S DFN=+Y
DS1 ;EP; -- ds main
D DSSD I Y<1 D Q Q
I $$DSV^ADGCRB5 S DGZP="" K DGZN
D BOT I $D(DIRUT) D Q Q
D NOC I $D(DIRUT) D Q Q
D ZIS I POP D Q Q
I $D(IO("Q")) D QUE,Q Q
D A,Q Q
;
DSSD ; -- select day surgery date
I '$D(^ADGDS(DFN,"DS")) D S Y=0 Q
. W !,"No Day Surgery for ",$P(^DPT(DFN,0),U),!
S DIC="^ADGDS("_DFN_",""DS"",",DIC(0)="AEFMNQ"
S DIC("B")=$S($D(^ADGDS(DFN,"DS",0)):$P(^(0),U,3),1:"")
D ^DIC S DGDS=+Y
Q
;
EN1 ;EP; -- A Sheet by Admission date
W @IOF,!!!?24,"PRINT A SHEETS BY ADMISSION DATE",!! S DGDS=0
D DT I X["^"!($D(DTOUT))!(X="") D Q Q
D BOT I $D(DIRUT) D Q Q
D NOC I $D(DIRUT) D Q Q
D ZIS I POP D Q Q
I $D(IO("Q")) D QUE1,Q Q
EN2 D LP1,Q Q
;
QUE1 ; -- queued output
S ZTRTN="EN2^ADGCRB0",ZTDESC="PRINT FORM 44-1"
F I="DFN","DGDS","DGFN","DGZC","DGZN" S ZTSAVE(I)=""
D ^%ZTLOAD Q
;
DT ; -- Admission date
S %DT="AEQ",%DT("A")="Select admission date: " D ^%DT Q:Y<0
S SD=Y-.0001,ED=Y+.2400 Q
;
LP1 ; -- loop admission date
S DGDT=SD F S DGDT=$O(^DGPM("AMV1",DGDT)) Q:'DGDT!(DGDT>ED) D
. S DFN=0 F S DFN=$O(^DGPM("AMV1",DGDT,DFN)) Q:'DFN D
.. S DGFN=0 F S DGFN=$O(^DGPM("AMV1",DGDT,DFN,DGFN)) Q:'DGFN D A
Q
ADGCRB0 ; IHS/ADC/PDW/ENM - A SHEET driver ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 SET DIC="^DPT("
SET DIC(0)="AQZEM"
SET DIC("A")="Select PATIENT NAME: "
+4 DO ^DIC
KILL DIC
IF Y'>0
GOTO Q
SET DFN=+Y
MAIN ; -- main
+1 IF '$DATA(DFN)!('$DATA(^DPT(DFN,0)))!('$DATA(^AUPNPAT(DFN,0)))
QUIT
+2 SET DGDS=0
SET DGFN=$SELECT($GET(DGFN):$GET(DGFN),1:0)
+3 ;D ASK:DGFN,1:'DGFN I 'DGFN D Q Q
+4 NEW X
SET X=$SELECT(DGFN:"ASK",1:1)
DO @X
IF 'DGFN
DO Q
QUIT
+5 DO BOT
IF $DATA(DIRUT)
DO Q
QUIT
+6 DO NOC
IF $DATA(DIRUT)
DO Q
QUIT
+7 DO ZIS
IF POP
DO Q
QUIT
+8 IF $DATA(IO("Q"))
DO QUE
DO Q
QUIT
+9 DO A
DO Q
QUIT
+10 ;
EN(DFN,DGFN) ;EP; -- predefined DFN entry point
+1 DO MAIN
QUIT
+2 ;
ASK ; -- print?
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to print A sheet"
SET DIR("B")="YES"
+2 DO ^DIR
IF 'Y
SET DGFN=0
QUIT
+3 ;
A USE IO
FOR DGZCNT=1:1:DGZC
Begin DoDot:1
+1 DO ^ADGCRB1
+2 ;2nd half (clinical data)
IF $DATA(DGZP)
DO ^ADGCRB5
IF DGVSDA
DO ^ADGCRB6
+3 ;2nd half (form outline)
IF $DATA(DGZN)
DO ^ADGCRB7
WRITE @IOF
End DoDot:1
+4 QUIT
+5 ;
1 ; -- admission
+1 NEW I,J,ID,Y,X
+2 IF '$DATA(^DGPM("APCA",DFN))
Begin DoDot:1
+3 WRITE !?5,"No admissions on file."
DO PRTOPT^ADGVAR
End DoDot:1
QUIT
+4 WRITE !!,"Admission(s)"
SET I=0
+5 SET ID=0
FOR
SET ID=$ORDER(^DGPM("ATID1",DFN,ID))
IF 'ID
QUIT
Begin DoDot:1
+6 SET DGFN=0
FOR
SET DGFN=$ORDER(^DGPM("ATID1",DFN,ID,DGFN))
IF 'DGFN
QUIT
Begin DoDot:2
+7 SET Y=+^DGPM(DGFN,0)
SET I=I+1
SET J(I)=DGFN
XECUTE ^DD("DD")
WRITE !?5,I,". ",Y
End DoDot:2
End DoDot:1
+8 IF I=1
SET DGFN=J(I)
QUIT
+9 KILL DIR
SET DIR("B")=1
SET DIR("A")="Select One"
SET DIR(0)="NO^1:"_I
DO ^DIR
KILL DIR
+10 IF Y=""
SET DGFN=J(1)
QUIT
+11 IF $DATA(DIRUT)!(Y=-1)
SET DGFN=0
QUIT
+12 SET DGFN=J(+Y)
+13 QUIT
+14 ;
BOT ; -- bottom half form?
+1 IF $DATA(DGZP)
QUIT
KILL DIR,DGZN
WRITE !
+2 SET DIR("A")="Print bottom half of form"
+3 SET DIR("B")=$SELECT($GET(DGDS):"NO",1:"YES")
SET DIR("?")=""
SET DIR(0)="Y"
+4 SET DIR("?",1)="Enter YES if you wish to print the headings for"
+5 SET DIR("?",2)=" the second half of the A Sheet form,"
+6 SET DIR("?",3)="Enter NO to leave second half blank."
+7 DO ^DIR
IF Y
SET DGZN=""
QUIT
+8 ;
NOC ; -- number of copies
+1 KILL DIR
SET DIR(0)="N^1:10"
SET DIR("B")=1
SET DIR("A")="Print How Many Copies"
+2 DO ^DIR
SET DGZC=Y
QUIT
+3 ;
ZIS ; -- select device
+1 SET %ZIS="PQ"
DO ^%ZIS
QUIT
+2 ;
QUE ; -- queued output
+1 SET ZTRTN="A^ADGCRB0"
SET ZTDESC="PRINT FORM 44-1"
+2 FOR I="DFN","DGDS","DGFN","DGZC","DGZN","DGZP"
SET ZTSAVE(I)=""
+3 DO ^%ZTLOAD
QUIT
+4 ;
Q ; -- cleanup
+1 KILL DGFN,DGZC,ZTSK,X,Y,DIC,IO("Q"),DGZCNT,%ZIS,DGLIN,DGLIN1,DIR
+2 KILL DGVSDA,DGPOVN0,DGPOVDA,DGN,DGN0,DGN11,DGN21,DGN33,DGDS,DFN,DGZP
+3 DO ^%ZISC
DO HOME^%ZIS
QUIT
+4 ;
DS ;EP; -- day surgery
+1 SET DIC="^DPT("
SET DIC(0)="AQZEM"
SET DIC("A")="Select PATIENT NAME: "
+2 DO ^DIC
KILL DIC
IF Y'>0
GOTO Q
SET DFN=+Y
DS1 ;EP; -- ds main
+1 DO DSSD
IF Y<1
DO Q
QUIT
+2 IF $$DSV^ADGCRB5
SET DGZP=""
KILL DGZN
+3 DO BOT
IF $DATA(DIRUT)
DO Q
QUIT
+4 DO NOC
IF $DATA(DIRUT)
DO Q
QUIT
+5 DO ZIS
IF POP
DO Q
QUIT
+6 IF $DATA(IO("Q"))
DO QUE
DO Q
QUIT
+7 DO A
DO Q
QUIT
+8 ;
DSSD ; -- select day surgery date
+1 IF '$DATA(^ADGDS(DFN,"DS"))
Begin DoDot:1
+2 WRITE !,"No Day Surgery for ",$PIECE(^DPT(DFN,0),U),!
End DoDot:1
SET Y=0
QUIT
+3 SET DIC="^ADGDS("_DFN_",""DS"","
SET DIC(0)="AEFMNQ"
+4 SET DIC("B")=$SELECT($DATA(^ADGDS(DFN,"DS",0)):$PIECE(^(0),U,3),1:"")
+5 DO ^DIC
SET DGDS=+Y
+6 QUIT
+7 ;
EN1 ;EP; -- A Sheet by Admission date
+1 WRITE @IOF,!!!?24,"PRINT A SHEETS BY ADMISSION DATE",!!
SET DGDS=0
+2 DO DT
IF X["^"!($DATA(DTOUT))!(X="")
DO Q
QUIT
+3 DO BOT
IF $DATA(DIRUT)
DO Q
QUIT
+4 DO NOC
IF $DATA(DIRUT)
DO Q
QUIT
+5 DO ZIS
IF POP
DO Q
QUIT
+6 IF $DATA(IO("Q"))
DO QUE1
DO Q
QUIT
EN2 DO LP1
DO Q
QUIT
+1 ;
QUE1 ; -- queued output
+1 SET ZTRTN="EN2^ADGCRB0"
SET ZTDESC="PRINT FORM 44-1"
+2 FOR I="DFN","DGDS","DGFN","DGZC","DGZN"
SET ZTSAVE(I)=""
+3 DO ^%ZTLOAD
QUIT
+4 ;
DT ; -- Admission date
+1 SET %DT="AEQ"
SET %DT("A")="Select admission date: "
DO ^%DT
IF Y<0
QUIT
+2 SET SD=Y-.0001
SET ED=Y+.2400
QUIT
+3 ;
LP1 ; -- loop admission date
+1 SET DGDT=SD
FOR
SET DGDT=$ORDER(^DGPM("AMV1",DGDT))
IF 'DGDT!(DGDT>ED)
QUIT
Begin DoDot:1
+2 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV1",DGDT,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+3 SET DGFN=0
FOR
SET DGFN=$ORDER(^DGPM("AMV1",DGDT,DFN,DGFN))
IF 'DGFN
QUIT
DO A
End DoDot:2
End DoDot:1
+4 QUIT
