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

ADGPM1.m

Go to the documentation of this file. 
  1. ADGPM1 ; IHS/ADC/PDW/ENM - VIEW ADMISSION HISTORY ; [ 03/25/1999  11:48 AM ]
  1.  ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
  1.  ;
  1.  W @IOF W !!?20,"VIEW A PATIENT'S ADMISSION HISTORY",!!
  1. A ; -- main
  1.  D SP I Y<0 D Q Q
  1.  D HD1,CS,HD2,L1,Q Q
  1.  ;
  1. SP ; -- patient 
  1.  S DIC="^DPT(",DIC(0)="AZQEM" D ^DIC I Y<0 Q
  1.  S DFN=+Y,DGDPTN0=Y(0) Q
  1.  ;
  1. HD1 ; -- heading 1
  1.  W @IOF,?11,"*****Confidential Patient Data Covered by Privacy Act*****"
  1.  W !,$P(DGDPTN0,U),?32,"DOB: ",$$DOB
  1.  W ?50,"Age: ",$$AGE,?60,"CHART #: ",$$HRCN^ADGF
  1.  S X="CURRENT STATUS" W !!?80-$L(X)/2,X S X="",$P(X,"=",80)="" W !,X
  1.  Q
  1.  ;
  1. HD2 ; -- heading 2
  1.  S X="ADMISSION HISTORY" W !!?80-$L(X)/2,X,! S X="",$P(X,"=",80)="" W X
  1.  W !!?8,"Admit Date",?25,"Ward",?32,"Service",?43,"Rm/Bed"
  1.  W ?51,"Discharge",?66,"Provider"
  1.  W !?3,"-----------------",?24,"------",?31,"---------",?43,"------"
  1.  W ?51,"-----------",?64,"--------------" Q
  1.  ;
  1. CS ; -- current status
  1.  D INP^DGRPD Q
  1.  ;
  1. L1 ; -- loop admissions
  1.  S DGDT=0 N X S X=0
  1.  F  S DGDT=$O(^DGPM("APTT1",DFN,DGDT)) Q:'DGDT  D
  1.  . S DGPMDA=0
  1.  . F  S DGPMDA=$O(^DGPM("APTT1",DFN,DGDT,DGPMDA)) Q:'DGPMDA  D
  1.  .. D PRNT
  1.  W ! Q
  1.  ;
  1. PRNT ; -- print admission data
  1.  Q:'$D(^DGPM(DGPMDA,0))  S DGPMN0=^(0),X=X+1
  1.  W !,"(",X,") ",$$ADT,?24,$$WD,?31,$$TS,?44,$$RM
  1.  W ?52,$$DS,?65,$$PR Q
  1.  ;
  1. Q ; -- cleanup
  1.  D PRTOPT^ADGVAR
  1.  K DGPMDA,DGPMN0,DFN,DGDPTN0,DGDT,DIC,X,Y,DA,DR,E Q
  1.  ;
  1. WD() ; -- ward
  1.  Q $E($P($G(^DIC(42,+$P(DGPMN0,U,6),0)),U),1,6)
  1.  ;
  1. RM() ; -- room
  1.  Q $P($G(^DG(405.4,+$P(DGPMN0,U,7),0)),U)
  1.  ;
  1. TS() ; -- treating specialty
  1.  N X S X=$O(^DGPM("APHY",DGPMDA,0)) Q:'X ""
  1.  S X=$P(^DGPM(X,0),U,9) Q:'X "" Q $E($P(^DIC(45.7,X,0),U),1,9)
  1.  ;
  1. PR() ; -- provider
  1.  N X S X=$O(^DGPM("APHY",DGPMDA,0)) Q:'X ""
  1.  S X=$P(^DGPM(X,0),U,8) Q:'X ""
  1.  Q $E($P($P($G(^VA(200,+X,0)),U),",",1),1,13)
  1.  ;
  1. DS() ; -- discharge
  1.  N X S X=$P(DGPMN0,U,17) Q:'X "" S X=+^DGPM(X,0) Q:'X ""
  1.  Q $E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
  1.  ;
  1. DOB() ; -- date of birth
  1.  N Y S Y=$P(DGDPTN0,U,3) Q:'Y "" X ^DD("DD") Q Y
  1.  ;
  1. ADT() ; -- admission date
  1.  N X S X=+DGPMN0 Q:'X ""
  1.  S Y=$P(X,".",2)_"000",Y=$E(Y,1,2)_":"_$E(Y,3,4)
  1.  Q $E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)_" ("_Y_")"
  1.  ;
  1. AGE() ; -- age
  1.  N X K ^UTILITY("DIQ1",$J) S DIC=2,DR=.033,DA=DFN D EN^DIQ1
  1.  S X=^UTILITY("DIQ1",$J,2,DFN,.033) K ^UTILITY("DIQ1",$J) Q X