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

ASDUT.m

Go to the documentation of this file. 
  1. ASDUT ; IHS/ADC/PDW/ENM - FUNCTIONS ; [ 03/25/1999  11:48 AM ]
  1.  ;;5.0;IHS SCHEDULING;;MAR 25, 1999
  1.  ;
  1. HRCN() ;EP; -- IHS health record number
  1.  Q $P($G(^AUPNPAT(+$G(DFN),41,+$G(DUZ(2)),0)),"^",2)
  1.  ;
  1. HRC(DFN) ;EP; -- IHS health record number
  1.  Q $P($G(^AUPNPAT(+$G(DFN),41,+$G(DUZ(2)),0)),U,2)
  1.  ;
  1. SCCC() ;EP -- state-county-community code (STCTYCOM index)
  1.  N X I '$D(DFN)!('$D(^AUPNPAT(DFN,11))) Q "UNKOWN"
  1.  S X=$P(^AUPNPAT(DFN,11),"^",17) I 'X Q "UNKNOWN"
  1.  S X=$P(^AUTTCOM(X,0),"^",8) I 'X Q "UNKNOWN"
  1.  S X=$E(X,5,7)_"-"_$E(X,3,4)_"-"_$E(X,1,2) Q X
  1.  ;
  1. HRN(DFN) ;EP; -- health record number with dashes
  1.  N X I '$D(DFN)!('$D(DUZ(2))) Q "UNKNOWN"
  1.  I '$D(^AUPNPAT(DFN,41,DUZ(2),0)) Q "UNKOWN"
  1.  S X=$P(^AUPNPAT(DFN,41,DUZ(2),0),"^",2)
  1.  I $L(X)=7 D  Q X
  1.  . S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,7)
  1.  S X="00000"_X,X=$E(X,$L(X)-5,$L(X))
  1.  S X=$E(X,1,2)_"-"_$E(X,3,4)_"-"_$E(X,5,6)
  1.  Q X
  1.  ;
  1.  Q $TR("123-45-67","1234567",$P($G(^AUPNPAT(+DFN,41,+DUZ(2),0)),"^",2))
  1.  ;
  1. SHS ; -- Health Summary set variables (used by patient inquiry--DGZPI)
  1.  S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_$E(Y,2,3)"
  1.  S APCHSPAT=DFN,APCHSCKP="",APCHSBRK="",APCHSNPG=0 Q
  1. KHS ; -- Health Summary kill variables
  1.  K APCHSCVD,APCHSICF,APCHSCKP,APCHSNPG,APCHSPG,APCHSQIT,APCHSHDR
  1.  K APCHSEGN,APCHSEGC,APCHSEGT,APCHSEGH,APCHSEGL,APCHSDLM,APCHSDLS
  1.  K APCHSHD2,APCHSBRK,APCHSNDM,APCHSN,APCHSQ,APCHSPAT Q
  1.  ;
  1. PCP(DFN) ;EP; returns primary care provider name
  1.  Q $$VAL^XBDIQ1(9000001,DFN,.14)
  1.  ;
  1. TD() ;EP; returns hrcn in terminal digit order
  1.  S Y=$$HRN(DFN) Q $P(Y,"-",3)_$P(Y,"-",2)
  1.  ;
  1. DIV() ;EP; -- returns division ien
  1.  Q $S($D(^DG(40.8,+$G(DIV),0)):DIV,1:+$O(^DG(40.8,"C",DUZ(2),0)))
  1.  ;
  1. ACTV(SDC) ;EP; -- returns 1 if clinic is active
  1.  Q $S($P($G(^SC(SDC,"I")),U)="":1,$P(^("I"),U)>DT:1,$P(^("I"),U,2)'>DT:1,1:0)
  1.  ;
  1. FULLNM(DFN) ;EP; -- returns name first last
  1.  NEW X S X=$P($P(^DPT(DFN,0),U)," ") Q $P(X,",",2)_" "_$P(X,",")
  1.  ;
  1. PC(SDC) ;EP; -- returns ien for princ clinic tied to sdc clinic
  1.  Q $S($P($G(^SC(SDC,"SL")),U,5)]"":$P(^("SL"),U,5),1:-1)
  1.  ;
  1. SHORTRS() ;EP; -- returns 1 if short form of RS selected
  1.  Q $S($P($G(^DG(40.8,$$DIV,"IHS")),U,2)="S":1,1:0)
  1.  ;
  1. HSTYP(SC,DFN) ;EP; -- returns health summary type
  1.  NEW X,AGE,Y
  1.  S X=$P($G(^SC(SC,9999999)),U,2) I X]"" Q X
  1.  S AGE=$$VAL^XBDIQ1(2,DFN,.033)
  1.  I AGE<15 Q $$PEDHS
  1.  Q $$ADULTHS
  1.  ;
  1. PEDHS() ; -- returns ien for pediatric health summary 
  1.  Q $O(^APCHSCTL("B","PEDIATRIC",0))
  1.  ;
  1. ADULTHS() ; -- returns ien for adult regular health summary
  1.  Q $O(^APCHSCTL("B","ADULT REGULAR",0))
  1.  ;
  1. CONF() ;EP; -- returns confidential warning
  1.  Q "Confidential Patient Data Covered by Privacy Act"
  1.  ;
  1. CONF1() ;EP; -- returns shortened confidential warning 
  1.  Q "Confidential Patient Data"
  1.  ;
  1. TIME ;ENTRY POINT to print time only
  1.  N X
  1.  S X=$E($$HTFM^XLFDT($H),1,12)
  1.  W $P($$FMTE^XLFDT(X,"2P")," ",2,3)
  1.  Q