Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGPCCE1

BDGPCCE1.m

Go to the documentation of this file. 
  1. BDGPCCE1 ; IHS/ANMC/LJF - BUILD DISPLAY SCREENS FOR CODE ;  [ 06/19/2002  11:37 AM ]
  1.  ;;5.3;PIMS;**1008**;APR 26, 2002
  1.  ;
  1.  ;cmi/anch/maw 12/7/2007 PATCH 1008 added code set versioning ADMIT,OP
  1.  ;
  1.  ;6/19/2002 LJF8 next line added per Linda
  1.  S IORVON=$G(IORVON),IORVOFF=$G(IORVOFF),IOUON=$G(IOUON),IOUOFF=$G(IOUOFF)    ;IHS/ANMC/LJF 6/18/2002 to prevent undef if device not set up completely
  1.  D ADMIT,POV,OP,PROV,OTHER Q
  1.  ;
  1. ADMIT ; build display of admit data   
  1.  NEW LINE,VH
  1.  S VH=$O(^AUPNVINP("AD",BDGV,0)) I 'VH D  Q
  1.  . D SET("** ERROR!  Cannot find V Hospitalization Entry! **",.VALMCNT)
  1.  ;
  1.  D SET(IORVON_"General Admission Data"_IORVOFF,.VALMCNT)
  1.  S LINE=$$PAD(IOUON_"Admission",42)_"Discharge"_IOUOFF
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  S LINE=$$PAD($$GET1^DIQ(9000010,BDGV,.01),38)
  1.  S LINE=LINE_$$GET1^DIQ(9000010.02,VH,.01)
  1.  D SET(LINE,.VALMCNT)     ;admit and disch dates
  1.  ;
  1.  S LINE=$$PAD($$GET1^DIQ(9000010.02,VH,.04),38)
  1.  S LINE=LINE_$$GET1^DIQ(9000010.02,VH,.05)
  1.  D SET(LINE,.VALMCNT)     ;admit and disch services
  1.  ;
  1.  S LINE=$$GET1^DIQ(9000010.02,VH,.07)_" ("
  1.  S X=$$GET1^DIQ(9000010.02,VH,.07,"I")
  1.  S LINE=$$PAD(LINE_$$GET1^DIQ(405.1,X,9999999.1)_")",38)
  1.  S LINE=LINE_$$GET1^DIQ(9000010.02,VH,.06)_" ("
  1.  S X=$$GET1^DIQ(9000010.02,VH,.06,"I")
  1.  S LINE=LINE_$$GET1^DIQ(405.1,X,9999999.1)_")"
  1.  D SET(LINE,.VALMCNT)      ;admit and disch types (IHS)
  1.  ;
  1.  S LINE=$$GET1^DIQ(9000010.02,VH,6101)
  1.  I LINE]"" S LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6101,"I")_")"
  1.  S LINE=$$PAD(LINE,38)_$$GET1^DIQ(9000010.02,VH,.09)
  1.  D SET(LINE,.VALMCNT)      ;admit type (ub92) & transfer facility
  1.  ;
  1.  S LINE=$$GET1^DIQ(9000010.02,VH,6102)
  1.  I LINE]"" S LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6102,"I")_")"
  1.  S LINE=$$PAD(LINE,38)_$$GET1^DIQ(9000010.02,VH,6103)
  1.  S LINE=LINE_" ("_$$GET1^DIQ(9000010.02,VH,6103,"I")_")"
  1.  D SET(LINE,.VALMCNT)     ;admit source & disch status (UB92 style)
  1.  ;
  1.  S LINE="DX upon Admission: ",X=$O(^DGPM("AVISIT",BDGV,0))
  1.  I X S LINE=LINE_$$GET1^DIQ(405,X,.1)
  1.  D SET(LINE,.VALMCNT)     ;free text admitting dx
  1.  ;
  1.  S LINE=$$SP(5)_"Coded Adm DX: "_$$GET1^DIQ(9000010.02,VH,.12)
  1.  I $L(LINE)>10 S LINE=LINE_" - "
  1.  ;S LINE=LINE_$$GET1^DIQ(80,+$$GET1^DIQ(9000010.02,VH,.12,"I"),3)
  1.  S LINE=LINE_$P($$ICDDX^ICDCODE(+$$GET1^DIQ(9000010.02,VH,.12,"I")),U,4)
  1.  D SET(LINE,.VALMCNT)     ;admitting dx
  1.  ;
  1.  S LINE=$$SP(14)_"DRG: "_$$GET1^DIQ(9000010,BDGV,.34)
  1.  I $L(LINE)>9 S LINE=LINE_" - "
  1.  S LINE=LINE_$G(^ICD(+$$GET1^DIQ(9000010,BDGV,.34,"I"),1,1,0))
  1.  D SET(LINE,.VALMCNT)     ;visit DRG
  1.  ;
  1.  S LINE=$$SP(7)_"# Consults: "_$$GET1^DIQ(9000010.02,VH,.08)
  1.  D SET(LINE,.VALMCNT)
  1.  D SET("",.VALMCNT)   ;blank line between sections
  1.  Q
  1.  ;
  1. POV ; build diagnosis display
  1.  NEW IEN,LINE,X,Y
  1.  I '$D(^AUPNVPOV("AD",BDGV)) D  Q
  1.  . D SET("** No Diagnoses Entered for Visit! **",.VALMCNT)
  1.  ;
  1.  D SET("",.VALMCNT),SET(IORVON_"POV (Diagnoses)"_IORVOFF,.VALMCNT)
  1.  S IEN=0 F  S IEN=$O(^AUPNVPOV("AD",BDGV,IEN)) Q:'IEN  D
  1.  . S LINE=$$GET1^DIQ(9000010.07,IEN,.01)
  1.  . S LINE=$$PAD(LINE,8)_"("_$$GET1^DIQ(9000010.07,IEN,.12,"I")_") "
  1.  . S LINE=LINE_$$GET1^DIQ(9000010.07,IEN,.019)
  1.  . D SET(LINE,.VALMCNT)    ;icd code, prim/sec and icd description
  1.  . ;
  1.  . D SET($$SP(12)_$$GET1^DIQ(9000010.07,IEN,.04),.VALMCNT)  ;prov narr
  1.  . ;
  1.  . S X=$$GET1^DIQ(9000010.07,IEN,.06),Y=$$GET1^DIQ(9000010.07,IEN,.07)
  1.  . I (X]"")!(Y]"") D
  1.  .. D SET($$PAD($$SP(12)_"Modifier: "_X,38)_"Cause of DX: "_Y,.VALMCNT)
  1.  . ;
  1.  . S X=$$GET1^DIQ(9000010.07,IEN,.09) I X]"" D
  1.  .. S LINE=$$PAD($$SP(12)_"E-Code: "_X,38)_$$GET1^DIQ(9000010.07,IEN,.13)
  1.  .. D SET(LINE,.VALMCNT)   ;e-code & date of injury
  1.  .. D SET($$SP(12)_"Place of Accident: "_$$GET1^DIQ(9000010.07,IEN,.11),.VALMCNT)
  1.  .. ;
  1.  .. D SET("",.VALMCNT)   ;blank line between dx
  1.  Q
  1.  ;
  1. OP ; build list of procedures
  1.  NEW IEN,LINE,X,Y
  1.  I '$D(^AUPNVPRC("AD",BDGV)) Q   ;no procedures
  1.  ;
  1.  D SET("",.VALMCNT),SET(IORVON_"Procedures"_IORVOFF,.VALMCNT)
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^AUPNVPRC("AD",BDGV,IEN)) Q:'IEN  D
  1.  . S LINE=$$PAD($$GET1^DIQ(9000010.08,IEN,.01),10)
  1.  . S X=$$GET1^DIQ(9000010.08,IEN,.07)   ;princ procedure?
  1.  . S LINE=$$PAD(LINE_$S(X="YES":" (P)",1:""),17)
  1.  . S LINE=LINE_$$GET1^DIQ(9000010.08,IEN,.019)
  1.  . D SET(LINE,.VALMCNT)     ;icd code, princ?, icd description
  1.  . ;
  1.  . D SET($$SP(10)_$$GET1^DIQ(9000010.08,IEN,.04),.VALMCNT)  ;prov narr
  1.  . ;
  1.  . S LINE=$$GET1^DIQ(9000010.08,IEN,.16)_$$GET1^DIQ(9000010.08,IEN,.17)
  1.  . S LINE=LINE_$$SP(3)_$$GET1^DIQ(9000010.08,IEN,.1609)
  1.  . S LINE=$$PAD("CPT: "_LINE,50)_"Infection? "
  1.  . S LINE=LINE_$$GET1^DIQ(9000010.08,IEN,.08)
  1.  . D SET(LINE,.VALMCNT)           ;CPT codes & infection question
  1.  . ;
  1.  . S LINE="Date: "_$$GET1^DIQ(9000010.08,IEN,.06)
  1.  . S X=$$GET1^DIQ(9000010.08,IEN,.05)
  1.  . I X]"" D
  1.  .. S Y=$$GET1^DIQ(9000010.08,IEN,.05,"I")
  1.  .. ;S X=X_$$SP(3)_$$GET1^DIQ(80,Y,3)
  1.  .. S X=X_$$SP(3)_$P($$ICDDX^ICDCODE(Y),U,4)
  1.  . D SET($$PAD(LINE,30)_"Dx: "_X,.VALMCNT)  ;date & dx
  1.  . ;
  1.  . S LINE="Operating: "_$$GET1^DIQ(9000010.08,IEN,.11)
  1.  . S X=$$GET1^DIQ(9000010.08,IEN,.12)
  1.  . I X]"" S LINE=$$PAD(LINE,38)_"Anesthesiologist: "_X
  1.  . D SET(LINE,.VALMCNT)        ;providers-operating & anesthesia
  1.  . ;
  1.  . S X=$$GET1^DIQ(9000010.08,IEN,.14)
  1.  . I X="YES" D
  1.  .. S LINE="Elapsed Time (Anes): "_$$GET1^DIQ(9000010.08,IEN,.13)
  1.  .. S LINE=$$PAD(LINE,38)_"ASA-PS Class: "_$$GET1^DIQ(9000010.08,IEN,.15)
  1.  .. D SET(LINE,.VALMCNT)    ;anesthesia data
  1.  . ;
  1.  . D SET("",.VALMCNT)   ;blank line between procedures
  1.  Q
  1.  ;
  1. PROV ; build display of providers
  1.  NEW IEN,LINE,X,Y
  1.  I '$D(^AUPNVPRV("AD",BDGV)) D  Q
  1.  . D SET("** No Providers Entered for Visit! **",.VALMCNT)
  1.  ;
  1.  D SET("",.VALMCNT),SET(IORVON_"Providers"_IORVOFF,.VALMCNT)
  1.  S IEN=0 F  S IEN=$O(^AUPNVPRV("AD",BDGV,IEN)) Q:'IEN  D
  1.  . S LINE=$$PAD($$GET1^DIQ(9000010.06,IEN,.01),37)   ;prov name
  1.  . S LINE=LINE_$$GET1^DIQ(9000010.06,IEN,.019)       ;prov code
  1.  . S X=$$GET1^DIQ(9000010.06,IEN,.04)                ;prim/sec
  1.  . S Y=$$GET1^DIQ(9000010.06,IEN,.05)                ;atten/oper/cons
  1.  . S LINE=$$PAD(LINE,50)_X_$S(Y]"":"/"_Y,1:"")
  1.  . D SET(LINE,.VALMCNT),SET("",.VALMCNT)
  1.  Q
  1.  ;
  1. OTHER ; build display of all other PCC data for patient's visit
  1.  NEW FILE,GLOBAL,IEN,LINE,X,Y,NAME
  1.  S FILE=9000010
  1.  F  S FILE=$O(^DIC(FILE)) Q:'FILE  Q:(FILE>9000010.9999)  D
  1.  . Q:FILE=9000010.02  Q:FILE=9000010.06  Q:FILE=9000010.07
  1.  . Q:FILE=9000010.08
  1.  . S GLOBAL=$G(^DIC(FILE,0,"GL")) Q:GLOBAL=""
  1.  . S GLOBAL=$P(GLOBAL,"(")            ;strip off parens for indirection
  1.  . S NAME=$P($P(^DIC(FILE,0),U),"V ",2)
  1.  . ;
  1.  . I $D(@GLOBAL@("AD",BDGV)) D SET("",.VALMCNT),SET(IORVON_NAME_IORVOFF,.VALMCNT)
  1.  . ;
  1.  . S IEN=0 F  S IEN=$O(@GLOBAL@("AD",BDGV,IEN)) Q:'IEN  D
  1.  .. S LINE=$$GET1^DIQ(FILE,IEN,.01)
  1.  .. ;
  1.  .. ;  do CPT file differently
  1.  .. I NAME="CPT" D  Q
  1.  ... S LINE=LINE_$$GET1^DIQ(FILE,IEN,.08)_$$SP(4)
  1.  ... S X=$$GET1^DIQ(FILE,IEN,.16)       ;quantity
  1.  ... S LINE=LINE_"("_$S(X="":1,1:X)_")  "
  1.  ... S LINE=LINE_$$GET1^DIQ(FILE,IEN,.019)   ;cpt short name
  1.  ... D SET(LINE,.VALMCNT),SET("",.VALMCNT)
  1.  .. ;
  1.  .. S LINE=LINE_$$SP(3)_$$GET1^DIQ(FILE,IEN,.04)
  1.  .. D SET(LINE,.VALMCNT),SET("",.VALMCNT)
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; puts display data into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGPCCE",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)