APCSSIL2 ; IHS/CMI/LAB - H1N1 SURVEILLANCE EXPORT 02 Nov 2009 8:28 AM ; 09 Dec 2009 2:54 PM
;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
;
;
SETREC ;EP - called from
;set delimited record
S C=","
S APCSREC=$$UID(DFN)
S $P(APCSREC,",",2)=$S($$HRN^AUPNPAT(DFN,APCSLOC)]"":$$HRN^AUPNPAT(DFN,APCSLOC),1:$$HRN^AUPNPAT(DFN,DUZ(2))) ;hrn at location of encounter, if none, then hrn at duz(2)
S $P(APCSREC,",",3)=$P(^DPT(DFN,0),U,2)
S $P(APCSREC,",",4)=$$JDATE($P(^DPT(DFN,0),U,3))
S $P(APCSREC,",",5)=$$COMMRES^AUPNPAT(DFN,"C")
S $P(APCSREC,",",6)=$P(^AUTTLOC(APCSLOC,0),U,10)
S $P(APCSREC,",",7)=$$JDATE(APCSDATE)
;povs
S X=0,APCSC=7 S Y=$P(APCSILI,U,2,99) F X=1:1 S Z=$P(Y,U,X) Q:APCSC>9!(Z="") I Z]"" S APCSC=APCSC+1,$P(APCSREC,",",APCSC)=Z
S APCSTEMP=""
S X=0 F S X=$O(^AUPNVMSR("AD",APCSV,X)) Q:X'=+X D
.Q:$P($G(^AUPNVMSR(X,2)),U,1)
.Q:$$VAL^XBDIQ1(9000010.01,X,.01)'="TMP" ;not a temperature
.S V=$P(^AUPNVMSR(X,0),U,4)
.S APCSTEMP=$S(V>APCSTEMP:V,1:APCSTEMP)
.S $P(APCSREC,",",11)=APCSTEMP
S $P(APCSREC,",",12)=$S($P($G(^AUPNVSIT(APCSV,11)),U,14)]"":$P($G(^AUPNVSIT(APCSV,11)),U,14),1:$$UIDV^AUPNVSIT(APCSV))
S $P(APCSREC,",",14)=$$JDATE($P(^AUPNVSIT(APCSV,0),U,13))
S $P(APCSREC,",",15)=$P(^AUPNVSIT(APCSV,0),U,7)
S $P(APCSREC,",",16)=$$DSCHTYPE^APCLSIL2(APCSV)
S $P(APCSREC,",",17)=$$JDATE($$DSCHDATE^APCLSIL2(APCSV))
S APCSREF="" I APCSH1N1!(APCSILI) S APCSREF=$$REF^APCLSIL2(APCSV) D
.S $P(APCSREC,",",18)=$P(APCSREF,U)
.S $P(APCSREC,",",19)=$P(APCSREF,U,2)
;S $P(APCSREC,",",21)=$P(APCSHVAC,U,2)
S $P(APCSREC,",",22)=$P(APCSIVAC,U,2)
;S APCSADV="" I APCSHVAC S $P(APCSREC,",",23)=$$ADV(APCSV)
S APCSASDM=$$ASTDM^APCLSIL2(DFN,$$VD^APCLV(APCSV))
S $P(APCSREC,",",33)=$P(APCSASDM,U,1)
S $P(APCSREC,",",34)=$P(APCSASDM,U,2)
S APCSBMI=$$BMI^APCLSIL2(DFN,$$VD^APCLV(APCSV))
S $P(APCSREC,",",35)=$$OB^APCLSIL2(DFN,$P(APCSBMI,U,1),$$AGE^AUPNPAT(DFN,$P(APCSBMI,U,6)))
S $P(APCSREC,",",36)=$$PN^APCLSIL1(DFN,APCSV)
S $P(APCSREC,",",37)=$$R^APCLSIL2($P(APCSBMI,U,1))
S $P(APCSREC,",",38)=$$JDATE($P(APCSBMI,U,6))
S %=$$PNEU^APCLSIL2(DFN,DT)
S $P(APCSREC,",",39)=$P(%,U,2)
S $P(APCSREC,",",40)=$P(%,U,1)
S $P(APCSREC,",",41)=$$CLINIC^APCLV(APCSV,"C")
S $P(APCSREC,",",43)=$P(APCSH1N1,U,2)
;S $P(APCSREC,",",44)=$P(APCSADVE,U,2)
S $P(APCSREC,",",45)=$P(APCSSRD,U,2)
S $P(APCSREC,",",46)=$P(APCSSRD,U,3)
S $P(APCSREC,",",47)=$P(APCSSRD,U,4)
S $P(APCSREC,",",48)=$P(APCSSRD,U,5)
;S $P(APCSREC,",",49)=$P(APCSAV9,U,2)
;S $P(APCSREC,",",50)=$P(APCSAV9,U,3)
;S $P(APCSREC,",",51)=$P(APCSAV9,U,4)
;S $P(APCSREC,",",52)=$P(APCSAV9,U,5)
;I $P(APCSHVAC,U,2)=125 S $P(APCSREC,",",53)=$$H1N1LIVE(APCSV)
S $P(APCSREC,",",59)=$$STRIP^XLFSTR($P(APCSAVM,U,2),",")
S $P(APCSREC,",",60)=$$STRIP^XLFSTR($P(APCSAVM,U,3),",")
;S $P(APCSREC,",",61)=$$STRIP^XLFSTR($P(APCSHVAC,U,3),",")
;S $P(APCSREC,",",62)=$$STRIP^XLFSTR($P(APCSHVAC,U,4),",")
S $P(APCSREC,",",63)="p27"
S $P(APCSREC,",",64)=$$STRIP^XLFSTR($P(APCSIVAC,U,3),",")
S $P(APCSREC,",",65)=$$STRIP^XLFSTR($P(APCSIVAC,U,4),",")
S $P(APCSREC,",",66)=$P(APCSADVE,U,2)
S $P(APCSREC,",",71)=APCSOVAC
S APCSVTOT=APCSVTOT+1
S ^APCSDATA($J,APCSVTOT)=APCSREC
Q
;
DATE(D) ;
Q (1700+$E(D,1,3))_$E(D,4,5)_$E(D,6,7)
;
JDATE(D) ;
I $G(D)="" Q ""
NEW A
S A=$$FMTE^XLFDT(D)
Q $E(D,6,7)_$$UP^XLFSTR($P(A," ",1))_(1700+$E(D,1,3))
;
UID(APCSA) ;Given DFN return unique patient record id.
I '$G(APCSA) Q ""
I '$D(^AUPNPAT(APCSA)) Q ""
;
Q $$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)_$E("0000000000",1,10-$L(APCSA))_APCSA
;
APCSSIL2 ; IHS/CMI/LAB - H1N1 SURVEILLANCE EXPORT 02 Nov 2009 8:28 AM ; 09 Dec 2009 2:54 PM
+1 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
+2 ;
+3 ;
SETREC ;EP - called from
+1 ;set delimited record
+2 SET C=","
+3 SET APCSREC=$$UID(DFN)
+4 ;hrn at location of encounter, if none, then hrn at duz(2)
SET $PIECE(APCSREC,",",2)=$SELECT($$HRN^AUPNPAT(DFN,APCSLOC)]"":$$HRN^AUPNPAT(DFN,APCSLOC),1:$$HRN^AUPNPAT(DFN,DUZ(2)))
+5 SET $PIECE(APCSREC,",",3)=$PIECE(^DPT(DFN,0),U,2)
+6 SET $PIECE(APCSREC,",",4)=$$JDATE($PIECE(^DPT(DFN,0),U,3))
+7 SET $PIECE(APCSREC,",",5)=$$COMMRES^AUPNPAT(DFN,"C")
+8 SET $PIECE(APCSREC,",",6)=$PIECE(^AUTTLOC(APCSLOC,0),U,10)
+9 SET $PIECE(APCSREC,",",7)=$$JDATE(APCSDATE)
+10 ;povs
+11 SET X=0
SET APCSC=7
SET Y=$PIECE(APCSILI,U,2,99)
FOR X=1:1
SET Z=$PIECE(Y,U,X)
IF APCSC>9!(Z="")
QUIT
IF Z]""
SET APCSC=APCSC+1
SET $PIECE(APCSREC,",",APCSC)=Z
+12 SET APCSTEMP=""
+13 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR("AD",APCSV,X))
IF X'=+X
QUIT
Begin DoDot:1
+14 IF $PIECE($GET(^AUPNVMSR(X,2)),U,1)
QUIT
+15 ;not a temperature
IF $$VAL^XBDIQ1(9000010.01,X,.01)'="TMP"
QUIT
+16 SET V=$PIECE(^AUPNVMSR(X,0),U,4)
+17 SET APCSTEMP=$SELECT(V>APCSTEMP:V,1:APCSTEMP)
+18 SET $PIECE(APCSREC,",",11)=APCSTEMP
End DoDot:1
+19 SET $PIECE(APCSREC,",",12)=$SELECT($PIECE($GET(^AUPNVSIT(APCSV,11)),U,14)]"":$PIECE($GET(^AUPNVSIT(APCSV,11)),U,14),1:$$UIDV^AUPNVSIT(APCSV))
+20 SET $PIECE(APCSREC,",",14)=$$JDATE($PIECE(^AUPNVSIT(APCSV,0),U,13))
+21 SET $PIECE(APCSREC,",",15)=$PIECE(^AUPNVSIT(APCSV,0),U,7)
+22 SET $PIECE(APCSREC,",",16)=$$DSCHTYPE^APCLSIL2(APCSV)
+23 SET $PIECE(APCSREC,",",17)=$$JDATE($$DSCHDATE^APCLSIL2(APCSV))
+24 SET APCSREF=""
IF APCSH1N1!(APCSILI)
SET APCSREF=$$REF^APCLSIL2(APCSV)
Begin DoDot:1
+25 SET $PIECE(APCSREC,",",18)=$PIECE(APCSREF,U)
+26 SET $PIECE(APCSREC,",",19)=$PIECE(APCSREF,U,2)
End DoDot:1
+27 ;S $P(APCSREC,",",21)=$P(APCSHVAC,U,2)
+28 SET $PIECE(APCSREC,",",22)=$PIECE(APCSIVAC,U,2)
+29 ;S APCSADV="" I APCSHVAC S $P(APCSREC,",",23)=$$ADV(APCSV)
+30 SET APCSASDM=$$ASTDM^APCLSIL2(DFN,$$VD^APCLV(APCSV))
+31 SET $PIECE(APCSREC,",",33)=$PIECE(APCSASDM,U,1)
+32 SET $PIECE(APCSREC,",",34)=$PIECE(APCSASDM,U,2)
+33 SET APCSBMI=$$BMI^APCLSIL2(DFN,$$VD^APCLV(APCSV))
+34 SET $PIECE(APCSREC,",",35)=$$OB^APCLSIL2(DFN,$PIECE(APCSBMI,U,1),$$AGE^AUPNPAT(DFN,$PIECE(APCSBMI,U,6)))
+35 SET $PIECE(APCSREC,",",36)=$$PN^APCLSIL1(DFN,APCSV)
+36 SET $PIECE(APCSREC,",",37)=$$R^APCLSIL2($PIECE(APCSBMI,U,1))
+37 SET $PIECE(APCSREC,",",38)=$$JDATE($PIECE(APCSBMI,U,6))
+38 SET %=$$PNEU^APCLSIL2(DFN,DT)
+39 SET $PIECE(APCSREC,",",39)=$PIECE(%,U,2)
+40 SET $PIECE(APCSREC,",",40)=$PIECE(%,U,1)
+41 SET $PIECE(APCSREC,",",41)=$$CLINIC^APCLV(APCSV,"C")
+42 SET $PIECE(APCSREC,",",43)=$PIECE(APCSH1N1,U,2)
+43 ;S $P(APCSREC,",",44)=$P(APCSADVE,U,2)
+44 SET $PIECE(APCSREC,",",45)=$PIECE(APCSSRD,U,2)
+45 SET $PIECE(APCSREC,",",46)=$PIECE(APCSSRD,U,3)
+46 SET $PIECE(APCSREC,",",47)=$PIECE(APCSSRD,U,4)
+47 SET $PIECE(APCSREC,",",48)=$PIECE(APCSSRD,U,5)
+48 ;S $P(APCSREC,",",49)=$P(APCSAV9,U,2)
+49 ;S $P(APCSREC,",",50)=$P(APCSAV9,U,3)
+50 ;S $P(APCSREC,",",51)=$P(APCSAV9,U,4)
+51 ;S $P(APCSREC,",",52)=$P(APCSAV9,U,5)
+52 ;I $P(APCSHVAC,U,2)=125 S $P(APCSREC,",",53)=$$H1N1LIVE(APCSV)
+53 SET $PIECE(APCSREC,",",59)=$$STRIP^XLFSTR($PIECE(APCSAVM,U,2),",")
+54 SET $PIECE(APCSREC,",",60)=$$STRIP^XLFSTR($PIECE(APCSAVM,U,3),",")
+55 ;S $P(APCSREC,",",61)=$$STRIP^XLFSTR($P(APCSHVAC,U,3),",")
+56 ;S $P(APCSREC,",",62)=$$STRIP^XLFSTR($P(APCSHVAC,U,4),",")
+57 SET $PIECE(APCSREC,",",63)="p27"
+58 SET $PIECE(APCSREC,",",64)=$$STRIP^XLFSTR($PIECE(APCSIVAC,U,3),",")
+59 SET $PIECE(APCSREC,",",65)=$$STRIP^XLFSTR($PIECE(APCSIVAC,U,4),",")
+60 SET $PIECE(APCSREC,",",66)=$PIECE(APCSADVE,U,2)
+61 SET $PIECE(APCSREC,",",71)=APCSOVAC
+62 SET APCSVTOT=APCSVTOT+1
+63 SET ^APCSDATA($JOB,APCSVTOT)=APCSREC
+64 QUIT
+65 ;
DATE(D) ;
+1 QUIT (1700+$EXTRACT(D,1,3))_$EXTRACT(D,4,5)_$EXTRACT(D,6,7)
+2 ;
JDATE(D) ;
+1 IF $GET(D)=""
QUIT ""
+2 NEW A
+3 SET A=$$FMTE^XLFDT(D)
+4 QUIT $EXTRACT(D,6,7)_$$UP^XLFSTR($PIECE(A," ",1))_(1700+$EXTRACT(D,1,3))
+5 ;
UID(APCSA) ;Given DFN return unique patient record id.
+1 IF '$GET(APCSA)
QUIT ""
+2 IF '$DATA(^AUPNPAT(APCSA))
QUIT ""
+3 ;
+4 QUIT $$GET1^DIQ(9999999.06,$PIECE(^AUTTSITE(1,0),U),.32)_$EXTRACT("0000000000",1,10-$LENGTH(APCSA))_APCSA
+5 ;
