BEDDTRPT.m

BEDDTRPT ;VNGT/HS/BEE-BEDD ED Triage Report  ; 08 Nov 2011  12:00 PM

 ;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13

 ;

 ;Adapted from BEDDTRGRPT/CNHS/RPF

 ;

 Q

 ;

EN(BEDDDFN,SITE,BEDDRPT) ;EP - BEDD ED Triage Report

 ;

 ; Input:

 ; BEDDDFN - Patient DFN

 ; SITE - Site

 ;

 ; Output:

 ; BEDDRPT Array

 ;

 S BEDDDFN=$G(BEDDDFN,"")

 ;

 ;Error Trapping

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDTRPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 NEW PNAME,PCHRT,PSEX,PDOB,VIEN,MIEN,DFN,RCNT

 K BEDDRPT

 S DFN=BEDDDFN

 S PNAME=$$GET1^DIQ(2,DFN_",",.01,"E")

 S PSEX=$$GET1^DIQ(2,DFN_",",.02,"E")

 S PDOB=$$FMTE^BEDDUTIL($$GET1^DIQ(2,DFN_",",.03,"I"))

 S PCHRT=$$GET1^DIQ(9000001.41,SITE_","_DFN_",",.02,"E")

 ;

 S VIEN=$$GET1^DIQ(9009081,DFN_",",1.1,"I")

 ;

 ;Display the ED Triage Report

 ;

 S RCNT=1,BEDDRPT(RCNT)="***ALERT***  THIS PAPER CONTAINS HEALTH INFORMATION *** ALERT ***"

 S RCNT=RCNT+1,BEDDRPT(RCNT)=""

 S RCNT=RCNT+1,BEDDRPT(RCNT)=PNAME

 S RCNT=RCNT+1,BEDDRPT(RCNT)="Chart Number: "_PCHRT_" - "_PSEX_" - DOB: "_PDOB

 S RCNT=RCNT+2,BEDDRPT(RCNT)=""

 S RCNT=RCNT+1,BEDDRPT(RCNT)="Patient Allergies: "_$$PTALG^BEDDUTIL(DFN)

 S RCNT=RCNT+1,BEDDRPT(RCNT)=""

 S RCNT=RCNT+1,BEDDRPT(RCNT)="TRIAGE LEVEL: "_$$GET1^DIQ(9009081,DFN_",",20,"I")

 S RCNT=RCNT+1

 S RCNT=RCNT+1,BEDDRPT(RCNT)="Chief Complaint: "_$$GET1^DIQ(9009081,DFN_",",8,"E")

 S RCNT=RCNT+1,BEDDRPT(RCNT)=""

 S RCNT=RCNT+1,BEDDRPT(RCNT)="Measurements: "

 ;

 ;Measurements

 S MIEN="" F  S MIEN=$O(^AUPNVMSR("AD",VIEN,MIEN)) Q:MIEN=""  D

 . ;

 . NEW MEAS,MVAL,MWHO,MDTM

 . S MEAS=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")

 . S MVAL=$$GET1^DIQ(9000010.01,MIEN_",",.01,"E")

 . S MWHO=$$GET1^DIQ(9000010.01,MIEN_",",1204,"E")

 . S MDTM=$P(^AUPNVMSR(MIEN,12),"^",1)

 . S RCNT=RCNT+1,BEDDRPT(RCNT)=$$FMTE^BEDDUTIL(MDTM)_" by "_MWHO

 . S RCNT=RCNT+1,BEDDRPT(RCNT)=MVAL_" - "_MEAS

 . S RCNT=RCNT+1,BEDDRPT(RCNT)=""

 S RCNT=RCNT+1

 Q

 ;

ERR ;EP - Capture the error

 D ^%ZTER

 Q

BEDDTRPT  ;VNGT/HS/BEE-BEDD ED Triage Report  ; 08 Nov 2011  12:00 PM

 +1       ;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13

 +2       ;

 +3       ;Adapted from BEDDTRGRPT/CNHS/RPF

 +4       ;

 +5        QUIT 

 +6       ;

EN(BEDDDFN,SITE,BEDDRPT) ;EP - BEDD ED Triage Report

 +1       ;

 +2       ; Input:

 +3       ; BEDDDFN - Patient DFN

 +4       ; SITE - Site

 +5       ;

 +6       ; Output:

 +7       ; BEDDRPT Array

 +8       ;

 +9        SET BEDDDFN=$GET(BEDDDFN,"")

 +10      ;

 +11      ;Error Trapping

 +12      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BEDDTRPT D UNWIND^%ZTER"

 +13      ;

 +14       NEW PNAME,PCHRT,PSEX,PDOB,VIEN,MIEN,DFN,RCNT

 +15       KILL BEDDRPT

 +16       SET DFN=BEDDDFN

 +17       SET PNAME=$$GET1^DIQ(2,DFN_",",.01,"E")

 +18       SET PSEX=$$GET1^DIQ(2,DFN_",",.02,"E")

 +19       SET PDOB=$$FMTE^BEDDUTIL($$GET1^DIQ(2,DFN_",",.03,"I"))

 +20       SET PCHRT=$$GET1^DIQ(9000001.41,SITE_","_DFN_",",.02,"E")

 +21      ;

 +22       SET VIEN=$$GET1^DIQ(9009081,DFN_",",1.1,"I")

 +23      ;

 +24      ;Display the ED Triage Report

 +25      ;

 +26       SET RCNT=1

           SET BEDDRPT(RCNT)="***ALERT***  THIS PAPER CONTAINS HEALTH INFORMATION *** ALERT ***"

 +27       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)=""

 +28       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)=PNAME

 +29       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)="Chart Number: "_PCHRT_" - "_PSEX_" - DOB: "_PDOB

 +30       SET RCNT=RCNT+2

           SET BEDDRPT(RCNT)=""

 +31       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)="Patient Allergies: "_$$PTALG^BEDDUTIL(DFN)

 +32       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)=""

 +33       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)="TRIAGE LEVEL: "_$$GET1^DIQ(9009081,DFN_",",20,"I")

 +34       SET RCNT=RCNT+1

 +35       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)="Chief Complaint: "_$$GET1^DIQ(9009081,DFN_",",8,"E")

 +36       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)=""

 +37       SET RCNT=RCNT+1

           SET BEDDRPT(RCNT)="Measurements: "

 +38      ;

 +39      ;Measurements

 +40       SET MIEN=""

           FOR 

               SET MIEN=$ORDER(^AUPNVMSR("AD",VIEN,MIEN))

               IF MIEN=""

                   QUIT 

               Begin DoDot:1

 +41      ;

 +42               NEW MEAS,MVAL,MWHO,MDTM

 +43               SET MEAS=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")

 +44               SET MVAL=$$GET1^DIQ(9000010.01,MIEN_",",.01,"E")

 +45               SET MWHO=$$GET1^DIQ(9000010.01,MIEN_",",1204,"E")

 +46               SET MDTM=$PIECE(^AUPNVMSR(MIEN,12),"^",1)

 +47               SET RCNT=RCNT+1

                   SET BEDDRPT(RCNT)=$$FMTE^BEDDUTIL(MDTM)_" by "_MWHO

 +48               SET RCNT=RCNT+1

                   SET BEDDRPT(RCNT)=MVAL_" - "_MEAS

 +49               SET RCNT=RCNT+1

                   SET BEDDRPT(RCNT)=""

               End DoDot:1

 +50       SET RCNT=RCNT+1

 +51       QUIT 

 +52      ;

ERR       ;EP - Capture the error

 +1        DO ^%ZTER

 +2        QUIT