- 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 ;
