BEDDPRT.m

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