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