BEDDPRT ;GDIT/HS/BEE-BEDD Admit Print Handling Routine ; 08 Nov 2011 12:00 PM
;;2.0;BEDD DASHBOARD;**2**;Jun 04, 2014;Build 26
;
Q
;
LABEL(DUZ,DFN,DEV,AMERCOPY) ;Print Labels
;
NEW DATA,X,ZTREQ
;
I $G(DEV)="" Q
I $G(DFN)="" Q
;
;Check for 0 copies
I +$G(AMERCOPY)=0 Q
;
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Set up DUZ
D DUZ^XUP(DUZ)
;
S DATA=$$QUEUE^CIAUTSK("PLABEL^BEDDPRT","BEDD: Print Labels",,"DFN^AMERCOPY","`"_+DEV)
;
Q
;
PLABEL ;Label Print Entry Point
;
;Log BUSA entry
D LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Labels",DFN) I 1
;
D START^AMERCLP
;
S IO("C")=""
D ^%ZISC
S ZTREQ="@"
Q
;
ROUTE(DUZ,DFN,DEV,AMERCOPY) ;Print Routing Slip
;
NEW DATA,X,ZTREQ,BEDDCOPY
;
I $G(DEV)="" Q
I $G(DFN)="" Q
;
;Check for 0 copies
I +$G(AMERCOPY)=0 Q
;
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Set up DUZ
D DUZ^XUP(DUZ)
;
;Log BUSA entry
D LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Routing Slip",DFN) I 1
;
;Task each copy
F BEDDCOPY=1:1:AMERCOPY D
. S DATA=$$QUEUE^CIAUTSK("PTROUTE^BEDDPRT","BEDD: Print Routing Slip",,"DFN","`"_+DEV)
;
Q
;
PTROUTE ;Routing Slip Print Entry Point
;
NEW BSDMODE,SDATE,SDX,SDSTART,ORDER,SDREP,DIV
;
S SDX="ALL",ORDER="",SDREP=0,SDSTART="",DIV=$$DIV^BSDU
;
I +$G(DFN)=0 Q
S BSDMODE="WI"
S SDATE=$$GET1^DIQ(9009081,DFN_",",1,"I")
;
D SINGLE^BSDROUT
;
S IO("C")=""
D ^%ZISC
S ZTREQ="@"
Q
;
MREC(DUZ,DFN,DEV,AMERCOPY) ;Print Med Rec Report
;
;
NEW DATA,X,ZTREQ,BEDDCOPY
;
I $G(DEV)="" Q
I $G(DFN)="" Q
;
;Check for 0 copies
I +$G(AMERCOPY)=0 Q
;
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Set up DUZ
D DUZ^XUP(DUZ)
;
;Log BUSA entry
D LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Medication Reconciliation",DFN) I 1
;
;Task each copy
F BEDDCOPY=1:1:AMERCOPY D
. S DATA=$$QUEUE^CIAUTSK("PMREC^BEDDPRT","BEDD: Print Medication Reconciliation",,"DFN","`"_+DEV)
;
Q
;
PMREC ;Print Medication Reconciliation
;
NEW VIEN
;
I $G(DFN)="" Q
;
;Get the visit
S VIEN=$$GET1^DIQ(9009081,DFN_",",1.1,"I") I VIEN="" Q
;
U IO
;
;Call the report
D START^BEDDMREC
;
S IO("C")=""
D ^%ZISC
S ZTREQ="@"
Q
;
PROUTE(DUZ,DFN,DEV,AMERCOPY) ;Print Patient Routing Slip
;
NEW DATA,X,ZTREQ,BEDDCOPY
;
I $G(DEV)="" Q
I $G(DFN)="" Q
;
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Check for 0 copies
I +$G(AMERCOPY)=0 Q
;
;Set up DUZ
D DUZ^XUP(DUZ)
;
;Task each copy
F BEDDCOPY=1:1:AMERCOPY D
. S DATA=$$QUEUE^CIAUTSK("PRTSLIP^BEDDPRT","BEDD: Print Patient Routing Slip",,"DFN","`"_+DEV)
;
Q
;
PRTSLIP ;Routing Slip Print Entry Point
;
I +$G(DFN)=0 Q
;
U IO
;
;Log BUSA entry
D LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Routing Slip",DFN) I 1
;
D START^BEDDEHRS
;
S IO("C")=""
D ^%ZISC
S ZTREQ="@"
Q
;
EMBCARD(DUZ,DFN,DEV,AGCOPY) ;Print Embossed Cards
;
NEW DATA,X,ZTREQ
;
I $G(DEV)="" Q
I $G(DFN)="" Q
;
;Check for 0 copies
I +$G(AGCOPY)=0 Q
;
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Set up DUZ
D DUZ^XUP(DUZ)
;
;Log BUSA entry
D LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed ER Embossed Card/Armband",DFN) I 1
;
S DATA=$$QUEUE^CIAUTSK("START^AGCARD","BEDD: Embossed Card for "_$P($G(^DPT(DFN,0)),U)_".",,"DFN^AGCOPY","`"_+DEV)
;
Q
;
CUSTOM(DUZ,DFN,NEWVISIT) ;Custom Print Call
;
NEW X,VIEN
;
I $G(DFN)="" Q
I $G(DUZ)="" Q
I $G(NEWVISIT)="" Q
;
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Set up DUZ
D DUZ^XUP(DUZ)
;
;Get the visit
S VIEN=$$GET1^DIQ(9009081,DFN_",",1.1,"I") I VIEN="" Q
;
;Make call to custom routine if it exists
D EN^XBNEW("EN^BEDDCPRT","DFN;VIEN;NEWVISIT")
;
Q
;
ERR ;
D ^%ZTER
Q
BEDDPRT ;GDIT/HS/BEE-BEDD Admit Print Handling Routine ; 08 Nov 2011 12:00 PM
+1 ;;2.0;BEDD DASHBOARD;**2**;Jun 04, 2014;Build 26
+2 ;
+3 QUIT
+4 ;
LABEL(DUZ,DFN,DEV,AMERCOPY) ;Print Labels
+1 ;
+2 NEW DATA,X,ZTREQ
+3 ;
+4 IF $GET(DEV)=""
QUIT
+5 IF $GET(DFN)=""
QUIT
+6 ;
+7 ;Check for 0 copies
+8 IF +$GET(AMERCOPY)=0
QUIT
+9 ;
+10 ;Make sure initial variables are set
+11 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+12 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+13 ;
+14 ;Set up DUZ
+15 DO DUZ^XUP(DUZ)
+16 ;
+17 SET DATA=$$QUEUE^CIAUTSK("PLABEL^BEDDPRT","BEDD: Print Labels",,"DFN^AMERCOPY","`"_+DEV)
+18 ;
+19 QUIT
+20 ;
PLABEL ;Label Print Entry Point
+1 ;
+2 ;Log BUSA entry
+3 DO LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Labels",DFN)
IF 1
+4 ;
+5 DO START^AMERCLP
+6 ;
+7 SET IO("C")=""
+8 DO ^%ZISC
+9 SET ZTREQ="@"
+10 QUIT
+11 ;
ROUTE(DUZ,DFN,DEV,AMERCOPY) ;Print Routing Slip
+1 ;
+2 NEW DATA,X,ZTREQ,BEDDCOPY
+3 ;
+4 IF $GET(DEV)=""
QUIT
+5 IF $GET(DFN)=""
QUIT
+6 ;
+7 ;Check for 0 copies
+8 IF +$GET(AMERCOPY)=0
QUIT
+9 ;
+10 ;Make sure initial variables are set
+11 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+12 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+13 ;
+14 ;Set up DUZ
+15 DO DUZ^XUP(DUZ)
+16 ;
+17 ;Log BUSA entry
+18 DO LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Routing Slip",DFN)
IF 1
+19 ;
+20 ;Task each copy
+21 FOR BEDDCOPY=1:1:AMERCOPY
Begin DoDot:1
+22 SET DATA=$$QUEUE^CIAUTSK("PTROUTE^BEDDPRT","BEDD: Print Routing Slip",,"DFN","`"_+DEV)
End DoDot:1
+23 ;
+24 QUIT
+25 ;
PTROUTE ;Routing Slip Print Entry Point
+1 ;
+2 NEW BSDMODE,SDATE,SDX,SDSTART,ORDER,SDREP,DIV
+3 ;
+4 SET SDX="ALL"
SET ORDER=""
SET SDREP=0
SET SDSTART=""
SET DIV=$$DIV^BSDU
+5 ;
+6 IF +$GET(DFN)=0
QUIT
+7 SET BSDMODE="WI"
+8 SET SDATE=$$GET1^DIQ(9009081,DFN_",",1,"I")
+9 ;
+10 DO SINGLE^BSDROUT
+11 ;
+12 SET IO("C")=""
+13 DO ^%ZISC
+14 SET ZTREQ="@"
+15 QUIT
+16 ;
MREC(DUZ,DFN,DEV,AMERCOPY) ;Print Med Rec Report
+1 ;
+2 ;
+3 NEW DATA,X,ZTREQ,BEDDCOPY
+4 ;
+5 IF $GET(DEV)=""
QUIT
+6 IF $GET(DFN)=""
QUIT
+7 ;
+8 ;Check for 0 copies
+9 IF +$GET(AMERCOPY)=0
QUIT
+10 ;
+11 ;Make sure initial variables are set
+12 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+13 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+14 ;
+15 ;Set up DUZ
+16 DO DUZ^XUP(DUZ)
+17 ;
+18 ;Log BUSA entry
+19 DO LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Medication Reconciliation",DFN)
IF 1
+20 ;
+21 ;Task each copy
+22 FOR BEDDCOPY=1:1:AMERCOPY
Begin DoDot:1
+23 SET DATA=$$QUEUE^CIAUTSK("PMREC^BEDDPRT","BEDD: Print Medication Reconciliation",,"DFN","`"_+DEV)
End DoDot:1
+24 ;
+25 QUIT
+26 ;
PMREC ;Print Medication Reconciliation
+1 ;
+2 NEW VIEN
+3 ;
+4 IF $GET(DFN)=""
QUIT
+5 ;
+6 ;Get the visit
+7 SET VIEN=$$GET1^DIQ(9009081,DFN_",",1.1,"I")
IF VIEN=""
QUIT
+8 ;
+9 USE IO
+10 ;
+11 ;Call the report
+12 DO START^BEDDMREC
+13 ;
+14 SET IO("C")=""
+15 DO ^%ZISC
+16 SET ZTREQ="@"
+17 QUIT
+18 ;
PROUTE(DUZ,DFN,DEV,AMERCOPY) ;Print Patient Routing Slip
+1 ;
+2 NEW DATA,X,ZTREQ,BEDDCOPY
+3 ;
+4 IF $GET(DEV)=""
QUIT
+5 IF $GET(DFN)=""
QUIT
+6 ;
+7 ;Make sure initial variables are set
+8 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+9 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+10 ;
+11 ;Check for 0 copies
+12 IF +$GET(AMERCOPY)=0
QUIT
+13 ;
+14 ;Set up DUZ
+15 DO DUZ^XUP(DUZ)
+16 ;
+17 ;Task each copy
+18 FOR BEDDCOPY=1:1:AMERCOPY
Begin DoDot:1
+19 SET DATA=$$QUEUE^CIAUTSK("PRTSLIP^BEDDPRT","BEDD: Print Patient Routing Slip",,"DFN","`"_+DEV)
End DoDot:1
+20 ;
+21 QUIT
+22 ;
PRTSLIP ;Routing Slip Print Entry Point
+1 ;
+2 IF +$GET(DFN)=0
QUIT
+3 ;
+4 USE IO
+5 ;
+6 ;Log BUSA entry
+7 DO LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed Patient ER Routing Slip",DFN)
IF 1
+8 ;
+9 DO START^BEDDEHRS
+10 ;
+11 SET IO("C")=""
+12 DO ^%ZISC
+13 SET ZTREQ="@"
+14 QUIT
+15 ;
EMBCARD(DUZ,DFN,DEV,AGCOPY) ;Print Embossed Cards
+1 ;
+2 NEW DATA,X,ZTREQ
+3 ;
+4 IF $GET(DEV)=""
QUIT
+5 IF $GET(DFN)=""
QUIT
+6 ;
+7 ;Check for 0 copies
+8 IF +$GET(AGCOPY)=0
QUIT
+9 ;
+10 ;Make sure initial variables are set
+11 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+12 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+13 ;
+14 ;Set up DUZ
+15 DO DUZ^XUP(DUZ)
+16 ;
+17 ;Log BUSA entry
+18 DO LOG^BEDDUTIU(DUZ,"P","P","BEDDADM","BEDD: Printed ER Embossed Card/Armband",DFN)
IF 1
+19 ;
+20 SET DATA=$$QUEUE^CIAUTSK("START^AGCARD","BEDD: Embossed Card for "_$PIECE($GET(^DPT(DFN,0)),U)_".",,"DFN^AGCOPY","`"_+DEV)
+21 ;
+22 QUIT
+23 ;
CUSTOM(DUZ,DFN,NEWVISIT) ;Custom Print Call
+1 ;
+2 NEW X,VIEN
+3 ;
+4 IF $GET(DFN)=""
QUIT
+5 IF $GET(DUZ)=""
QUIT
+6 IF $GET(NEWVISIT)=""
QUIT
+7 ;
+8 ;Make sure initial variables are set
+9 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+10 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+11 ;
+12 ;Set up DUZ
+13 DO DUZ^XUP(DUZ)
+14 ;
+15 ;Get the visit
+16 SET VIEN=$$GET1^DIQ(9009081,DFN_",",1.1,"I")
IF VIEN=""
QUIT
+17 ;
+18 ;Make call to custom routine if it exists
+19 DO EN^XBNEW("EN^BEDDCPRT","DFN;VIEN;NEWVISIT")
+20 ;
+21 QUIT
+22 ;
ERR ;
+1 DO ^%ZTER
+2 QUIT
