- BHSMU2 ;IHS/CIA/MGH - Health Summary Utilities ;17-Mar-2009 16:21;MGH
- ;;1.0;HEALTH SUMMARY COMPONENTS;**2**;March 17, 2006
- ;===================================================================
- ;Taken from APCHSMU2
- ; IHS/CMI/LAB - utilities for hmr ; [ 03/29/04 12:27 PM ]
- ;;2.0;IHS RPMS/PCC Health Summary;**9,11,12**;JUN 24, 1997
- ;=================================================================
- ;Patch 2 CSV changes in CPT
- ;
- LASTTD(P) ;EP
- NEW X,E,B,%DT,Y,TDD,D,BHSY
- K TDD
- I '$$BI^BHSMU1 D LASTTDO
- I $$BI^BHSMU1 D LASTTDN
- ;now check cpt codes
- F %=1:1 S T=$T(TDCPTS+%^BHSMU1) Q:$P(T,";;",2)="" S T=$P(T,";;",2),T=$O(^ICPT("B",T,0)) I T S X=$O(^AUPNVCPT("AA",P,T,0)) I X]"" S TDD(X)=""
- I '$D(TDD) Q ""
- Q 9999999-$O(TDD(0))
- LASTTDN ;
- S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
- .S B=$P(^AUPNVIMM(X,0),U) Q:'B
- .Q:'$D(^AUTTIMM(B,0))
- .S B=$P(^AUTTIMM(B,0),U,3)
- .S D=$P(^AUPNVIMM(X,0),U,3) Q:'D
- .S D=$P($P($G(^AUPNVSIT(D,0)),U),".")
- .I B=1 S TDD(9999999-D)="" Q
- .I B=9 S TDD(9999999-D)="" Q
- .I B=20 S TDD(9999999-D)="" Q
- .I B=22 S TDD(9999999-D)="" Q
- .I B=28 S TDD(9999999-D)="" Q
- .I B=35 S TDD(9999999-D)="" Q
- .I B=50 S TDD(9999999-D)="" Q
- .I B=106 S TDD(9999999-D)="" Q
- .I B=107 S TDD(9999999-D)="" Q
- .I B=110 S TDD(9999999-D)="" Q
- Q
- ;;
- LASTTDO ;
- S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
- .S B=$P(^AUPNVIMM(X,0),U) Q:'B
- .Q:'$D(^AUTTIMM(B,0))
- .S B=$P(^AUTTIMM(B,0),U,3)
- .S D=$P(^AUPNVIMM(X,0),U,3) Q:'D
- .S D=$P($P($G(^AUPNVSIT(D,0)),U),".")
- .I B="04" S TDD(9999999-D)="" Q
- .I B=42 S TDD(9999999-D)="" Q
- .I B=34 S TDD(9999999-D)="" Q
- .I B="03" S TDD(9999999-D)="" Q
- .I B="02" S TDD(9999999-D)="" Q
- Q
- LASTPN(P) ;EP
- NEW X,E,B,%DT,Y,TDD,D,BHSY
- K TDD
- I '$$BI^BHSMU1 D LASTPNO
- I $$BI^BHSMU1 D LASTPNN
- ;now check cpt codes
- F %=1:1 S T=$T(PNCPTS+%^BHSMU1) Q:$P(T,";;",2)="" S T=$P(T,";;",2),T=$O(^ICPT("B",T,0)) I T S X=$O(^AUPNVCPT("AA",P,T,0)) I X]"" S TDD(X)=""
- I '$D(TDD) Q ""
- Q 9999999-($O(TDD(0)))
- ;
- LASTPNN ;
- S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
- .S B=$P(^AUPNVIMM(X,0),U) Q:'B
- .Q:'$D(^AUTTIMM(B,0))
- .S B=$P(^AUTTIMM(B,0),U,3)
- .S D=$P(^AUPNVIMM(X,0),U,3) Q:'D
- .S D=$P($P($G(^AUPNVSIT(D,0)),U),".")
- .I B=33 S TDD(9999999-D)="" Q
- .I B=100 S TDD(9999999-D)="" Q
- .I B=109 S TDD(9999999-D)="" Q
- Q
- ;;
- LASTPNO ;
- S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
- .S B=$P(^AUPNVIMM(X,0),U) Q:'B
- .Q:'$D(^AUTTIMM(B,0))
- .S B=$P(^AUTTIMM(B,0),U,3)
- .S D=$P(^AUPNVIMM(X,0),U,3) Q:'D
- .S D=$P($P($G(^AUPNVSIT(D,0)),U),".")
- .I B=19 S TDD(9999999-D)="" Q
- Q
- LASTFLU(P) ;EP
- NEW X,E,B,%DT,Y,TDD,D,BHSY
- K TDD
- I '$$BI^BHSMU1 D LASTFLO
- I $$BI^BHSMU1 D LASTFLN
- ;now check cpt codes
- F %=1:1 S T=$T(FLUCPTS+%^BHSMU1) Q:$P(T,";;",2)="" S T=$P(T,";;",2),T=$O(^ICPT("B",T,0)) I T S X=$O(^AUPNVCPT("AA",P,T,0)) I X]"" S TDD(X)=""
- K BHSY S %=P_"^LAST DX V04.8",E=$$START1^APCLDF(%,"BHSY(")
- I $D(BHSY(1)) S TDD(9999999-$P(BHSY(1),U))=""
- K BHSY S %=P_"^LAST DX V04.81",E=$$START1^APCLDF(%,"BHSY(")
- I $D(BHSY(1)) S TDD(9999999-$P(BHSY(1),U))=""
- K BHSY S %=P_"^LAST DX V06.6",E=$$START1^APCLDF(%,"BHSY(")
- I $D(BHSY(1)) S TDD(9999999-$P(BHSY(1),U))=""
- K BHSY S %=P_"^LAST PROCEDURE 99.52",E=$$START1^APCLDF(%,"BHSY(")
- I $D(BHSY(1)) S TDD(9999999-$P(BHSY(1),U))=""
- I '$D(TDD) Q ""
- Q 9999999-($O(TDD(0)))
- ;
- LASTFLN ;
- S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
- .S B=$P(^AUPNVIMM(X,0),U) Q:'B
- .Q:'$D(^AUTTIMM(B,0))
- .S B=$P(^AUTTIMM(B,0),U,3)
- .S D=$P(^AUPNVIMM(X,0),U,3) Q:'D
- .S D=$P($P($G(^AUPNVSIT(D,0)),U),".")
- .I B=15 S TDD(9999999-D)="" Q
- .I B=16 S TDD(9999999-D)="" Q
- .I B=88 S TDD(9999999-D)="" Q
- .I B=111 S TDD(9999999-D)="" Q
- Q
- ;;
- LASTFLO ;
- S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
- .S B=$P(^AUPNVIMM(X,0),U) Q:'B
- .Q:'$D(^AUTTIMM(B,0))
- .S B=$P(^AUTTIMM(B,0),U,3)
- .S D=$P(^AUPNVIMM(X,0),U,3) Q:'D
- .S D=$P($P($G(^AUPNVSIT(D,0)),U),".")
- .I B=12 S TDD(9999999-D)="" Q
- Q
- WH(P,BDATE,EDATE,T,F) ;EP
- I '$G(P) Q ""
- I '$G(T) Q ""
- I '$G(F) S F=1
- I $G(EDATE)="" Q ""
- I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
- ;go through procedures in a date range for this patient, check proc type
- NEW D,X,Y,G,V
- S (G,V)=0 F S V=$O(^BWPCD("C",P,V)) Q:V=""!(G) D
- .Q:'$D(^BWPCD(V,0))
- .I $P(^BWPCD(V,0),U,4)'=T Q
- .S D=$P(^BWPCD(V,0),U,12)
- .Q:D<BDATE
- .Q:D>EDATE
- .S G=V
- .Q
- I 'G Q ""
- I F=1 Q $S(G:1,1:"")
- I F=2 Q G
- I F=3 S D=$P(^BWPCD(G,0),U,12) Q D
- I F=4 S D=$P(^BWPCD(G,0),U,12) Q $$FMTE^XLFDT(D)
- Q ""
- CPT(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT
- I '$G(P) Q ""
- I '$G(T) Q ""
- I '$G(F) S F=1
- I $G(EDATE)="" Q ""
- I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
- ;go through visits in a date range for this patient, check cpts
- NEW D,BD,ED,X,Y,D,G,V
- S ED=9999999-EDATE,BD=9999999-BDATE,G=0
- F S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
- .S V=0 F S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G) D
- ..Q:'$D(^AUPNVSIT(V,0))
- ..Q:'$D(^AUPNVCPT("AD",V))
- ..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G) D
- ...I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),T,1) S G=X
- ...Q
- ..Q
- .Q
- I 'G Q ""
- I F=1 Q $S(G:1,1:"")
- I F=2 Q G
- I F=3 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
- I F=4 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
- ;Patch 2 cvs changes
- N APCHSVDT
- ;I F=5 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^ICPT($P(^AUPNVCPT(G,0),U),0),U)
- I F=5 S V=$P(^AUPNVCPT(G,0),U,3) I V S APCHSVDT=$P(+V,".") Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P($$CPT^ICPTCOD($P(^AUPNVCPT(G,0),U),APCHSVDT),U,2)
- Q ""
- BHSMU2 ;IHS/CIA/MGH - Health Summary Utilities ;17-Mar-2009 16:21;MGH
- +1 ;;1.0;HEALTH SUMMARY COMPONENTS;**2**;March 17, 2006
- +2 ;===================================================================
- +3 ;Taken from APCHSMU2
- +4 ; IHS/CMI/LAB - utilities for hmr ; [ 03/29/04 12:27 PM ]
- +5 ;;2.0;IHS RPMS/PCC Health Summary;**9,11,12**;JUN 24, 1997
- +6 ;=================================================================
- +7 ;Patch 2 CSV changes in CPT
- +8 ;
- LASTTD(P) ;EP
- +1 NEW X,E,B,%DT,Y,TDD,D,BHSY
- +2 KILL TDD
- +3 IF '$$BI^BHSMU1
- DO LASTTDO
- +4 IF $$BI^BHSMU1
- DO LASTTDN
- +5 ;now check cpt codes
- +6 FOR %=1:1
- SET T=$TEXT(TDCPTS+%^BHSMU1)
- IF $PIECE(T,";;",2)=""
- QUIT
- SET T=$PIECE(T,";;",2)
- SET T=$ORDER(^ICPT("B",T,0))
- IF T
- SET X=$ORDER(^AUPNVCPT("AA",P,T,0))
- IF X]""
- SET TDD(X)=""
- +7 IF '$DATA(TDD)
- QUIT ""
- +8 QUIT 9999999-$ORDER(TDD(0))
- LASTTDN ;
- +1 SET X=0
- FOR
- SET X=$ORDER(^AUPNVIMM("AC",P,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 SET B=$PIECE(^AUPNVIMM(X,0),U)
- IF 'B
- QUIT
- +3 IF '$DATA(^AUTTIMM(B,0))
- QUIT
- +4 SET B=$PIECE(^AUTTIMM(B,0),U,3)
- +5 SET D=$PIECE(^AUPNVIMM(X,0),U,3)
- IF 'D
- QUIT
- +6 SET D=$PIECE($PIECE($GET(^AUPNVSIT(D,0)),U),".")
- +7 IF B=1
- SET TDD(9999999-D)=""
- QUIT
- +8 IF B=9
- SET TDD(9999999-D)=""
- QUIT
- +9 IF B=20
- SET TDD(9999999-D)=""
- QUIT
- +10 IF B=22
- SET TDD(9999999-D)=""
- QUIT
- +11 IF B=28
- SET TDD(9999999-D)=""
- QUIT
- +12 IF B=35
- SET TDD(9999999-D)=""
- QUIT
- +13 IF B=50
- SET TDD(9999999-D)=""
- QUIT
- +14 IF B=106
- SET TDD(9999999-D)=""
- QUIT
- +15 IF B=107
- SET TDD(9999999-D)=""
- QUIT
- +16 IF B=110
- SET TDD(9999999-D)=""
- QUIT
- End DoDot:1
- +17 QUIT
- +18 ;;
- LASTTDO ;
- +1 SET X=0
- FOR
- SET X=$ORDER(^AUPNVIMM("AC",P,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 SET B=$PIECE(^AUPNVIMM(X,0),U)
- IF 'B
- QUIT
- +3 IF '$DATA(^AUTTIMM(B,0))
- QUIT
- +4 SET B=$PIECE(^AUTTIMM(B,0),U,3)
- +5 SET D=$PIECE(^AUPNVIMM(X,0),U,3)
- IF 'D
- QUIT
- +6 SET D=$PIECE($PIECE($GET(^AUPNVSIT(D,0)),U),".")
- +7 IF B="04"
- SET TDD(9999999-D)=""
- QUIT
- +8 IF B=42
- SET TDD(9999999-D)=""
- QUIT
- +9 IF B=34
- SET TDD(9999999-D)=""
- QUIT
- +10 IF B="03"
- SET TDD(9999999-D)=""
- QUIT
- +11 IF B="02"
- SET TDD(9999999-D)=""
- QUIT
- End DoDot:1
- +12 QUIT
- LASTPN(P) ;EP
- +1 NEW X,E,B,%DT,Y,TDD,D,BHSY
- +2 KILL TDD
- +3 IF '$$BI^BHSMU1
- DO LASTPNO
- +4 IF $$BI^BHSMU1
- DO LASTPNN
- +5 ;now check cpt codes
- +6 FOR %=1:1
- SET T=$TEXT(PNCPTS+%^BHSMU1)
- IF $PIECE(T,";;",2)=""
- QUIT
- SET T=$PIECE(T,";;",2)
- SET T=$ORDER(^ICPT("B",T,0))
- IF T
- SET X=$ORDER(^AUPNVCPT("AA",P,T,0))
- IF X]""
- SET TDD(X)=""
- +7 IF '$DATA(TDD)
- QUIT ""
- +8 QUIT 9999999-($ORDER(TDD(0)))
- +9 ;
- LASTPNN ;
- +1 SET X=0
- FOR
- SET X=$ORDER(^AUPNVIMM("AC",P,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 SET B=$PIECE(^AUPNVIMM(X,0),U)
- IF 'B
- QUIT
- +3 IF '$DATA(^AUTTIMM(B,0))
- QUIT
- +4 SET B=$PIECE(^AUTTIMM(B,0),U,3)
- +5 SET D=$PIECE(^AUPNVIMM(X,0),U,3)
- IF 'D
- QUIT
- +6 SET D=$PIECE($PIECE($GET(^AUPNVSIT(D,0)),U),".")
- +7 IF B=33
- SET TDD(9999999-D)=""
- QUIT
- +8 IF B=100
- SET TDD(9999999-D)=""
- QUIT
- +9 IF B=109
- SET TDD(9999999-D)=""
- QUIT
- End DoDot:1
- +10 QUIT
- +11 ;;
- LASTPNO ;
- +1 SET X=0
- FOR
- SET X=$ORDER(^AUPNVIMM("AC",P,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 SET B=$PIECE(^AUPNVIMM(X,0),U)
- IF 'B
- QUIT
- +3 IF '$DATA(^AUTTIMM(B,0))
- QUIT
- +4 SET B=$PIECE(^AUTTIMM(B,0),U,3)
- +5 SET D=$PIECE(^AUPNVIMM(X,0),U,3)
- IF 'D
- QUIT
- +6 SET D=$PIECE($PIECE($GET(^AUPNVSIT(D,0)),U),".")
- +7 IF B=19
- SET TDD(9999999-D)=""
- QUIT
- End DoDot:1
- +8 QUIT
- LASTFLU(P) ;EP
- +1 NEW X,E,B,%DT,Y,TDD,D,BHSY
- +2 KILL TDD
- +3 IF '$$BI^BHSMU1
- DO LASTFLO
- +4 IF $$BI^BHSMU1
- DO LASTFLN
- +5 ;now check cpt codes
- +6 FOR %=1:1
- SET T=$TEXT(FLUCPTS+%^BHSMU1)
- IF $PIECE(T,";;",2)=""
- QUIT
- SET T=$PIECE(T,";;",2)
- SET T=$ORDER(^ICPT("B",T,0))
- IF T
- SET X=$ORDER(^AUPNVCPT("AA",P,T,0))
- IF X]""
- SET TDD(X)=""
- +7 KILL BHSY
- SET %=P_"^LAST DX V04.8"
- SET E=$$START1^APCLDF(%,"BHSY(")
- +8 IF $DATA(BHSY(1))
- SET TDD(9999999-$PIECE(BHSY(1),U))=""
- +9 KILL BHSY
- SET %=P_"^LAST DX V04.81"
- SET E=$$START1^APCLDF(%,"BHSY(")
- +10 IF $DATA(BHSY(1))
- SET TDD(9999999-$PIECE(BHSY(1),U))=""
- +11 KILL BHSY
- SET %=P_"^LAST DX V06.6"
- SET E=$$START1^APCLDF(%,"BHSY(")
- +12 IF $DATA(BHSY(1))
- SET TDD(9999999-$PIECE(BHSY(1),U))=""
- +13 KILL BHSY
- SET %=P_"^LAST PROCEDURE 99.52"
- SET E=$$START1^APCLDF(%,"BHSY(")
- +14 IF $DATA(BHSY(1))
- SET TDD(9999999-$PIECE(BHSY(1),U))=""
- +15 IF '$DATA(TDD)
- QUIT ""
- +16 QUIT 9999999-($ORDER(TDD(0)))
- +17 ;
- LASTFLN ;
- +1 SET X=0
- FOR
- SET X=$ORDER(^AUPNVIMM("AC",P,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 SET B=$PIECE(^AUPNVIMM(X,0),U)
- IF 'B
- QUIT
- +3 IF '$DATA(^AUTTIMM(B,0))
- QUIT
- +4 SET B=$PIECE(^AUTTIMM(B,0),U,3)
- +5 SET D=$PIECE(^AUPNVIMM(X,0),U,3)
- IF 'D
- QUIT
- +6 SET D=$PIECE($PIECE($GET(^AUPNVSIT(D,0)),U),".")
- +7 IF B=15
- SET TDD(9999999-D)=""
- QUIT
- +8 IF B=16
- SET TDD(9999999-D)=""
- QUIT
- +9 IF B=88
- SET TDD(9999999-D)=""
- QUIT
- +10 IF B=111
- SET TDD(9999999-D)=""
- QUIT
- End DoDot:1
- +11 QUIT
- +12 ;;
- LASTFLO ;
- +1 SET X=0
- FOR
- SET X=$ORDER(^AUPNVIMM("AC",P,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +2 SET B=$PIECE(^AUPNVIMM(X,0),U)
- IF 'B
- QUIT
- +3 IF '$DATA(^AUTTIMM(B,0))
- QUIT
- +4 SET B=$PIECE(^AUTTIMM(B,0),U,3)
- +5 SET D=$PIECE(^AUPNVIMM(X,0),U,3)
- IF 'D
- QUIT
- +6 SET D=$PIECE($PIECE($GET(^AUPNVSIT(D,0)),U),".")
- +7 IF B=12
- SET TDD(9999999-D)=""
- QUIT
- End DoDot:1
- +8 QUIT
- WH(P,BDATE,EDATE,T,F) ;EP
- +1 IF '$GET(P)
- QUIT ""
- +2 IF '$GET(T)
- QUIT ""
- +3 IF '$GET(F)
- SET F=1
- +4 IF $GET(EDATE)=""
- QUIT ""
- +5 IF $GET(BDATE)=""
- SET BDATE=$$FMADD^XLFDT(EDATE,-365)
- +6 ;go through procedures in a date range for this patient, check proc type
- +7 NEW D,X,Y,G,V
- +8 SET (G,V)=0
- FOR
- SET V=$ORDER(^BWPCD("C",P,V))
- IF V=""!(G)
- QUIT
- Begin DoDot:1
- +9 IF '$DATA(^BWPCD(V,0))
- QUIT
- +10 IF $PIECE(^BWPCD(V,0),U,4)'=T
- QUIT
- +11 SET D=$PIECE(^BWPCD(V,0),U,12)
- +12 IF D<BDATE
- QUIT
- +13 IF D>EDATE
- QUIT
- +14 SET G=V
- +15 QUIT
- End DoDot:1
- +16 IF 'G
- QUIT ""
- +17 IF F=1
- QUIT $SELECT(G:1,1:"")
- +18 IF F=2
- QUIT G
- +19 IF F=3
- SET D=$PIECE(^BWPCD(G,0),U,12)
- QUIT D
- +20 IF F=4
- SET D=$PIECE(^BWPCD(G,0),U,12)
- QUIT $$FMTE^XLFDT(D)
- +21 QUIT ""
- CPT(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT
- +1 IF '$GET(P)
- QUIT ""
- +2 IF '$GET(T)
- QUIT ""
- +3 IF '$GET(F)
- SET F=1
- +4 IF $GET(EDATE)=""
- QUIT ""
- +5 IF $GET(BDATE)=""
- SET BDATE=$$FMADD^XLFDT(EDATE,-365)
- +6 ;go through visits in a date range for this patient, check cpts
- +7 NEW D,BD,ED,X,Y,D,G,V
- +8 SET ED=9999999-EDATE
- SET BD=9999999-BDATE
- SET G=0
- +9 FOR
- SET ED=$ORDER(^AUPNVSIT("AA",P,ED))
- IF ED=""!($PIECE(ED,".")>BD)!(G)
- QUIT
- Begin DoDot:1
- +10 SET V=0
- FOR
- SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))
- IF V'=+V!(G)
- QUIT
- Begin DoDot:2
- +11 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +12 IF '$DATA(^AUPNVCPT("AD",V))
- QUIT
- +13 SET X=0
- FOR
- SET X=$ORDER(^AUPNVCPT("AD",V,X))
- IF X'=+X!(G)
- QUIT
- Begin DoDot:3
- +14 IF $$ICD^ATXCHK($PIECE(^AUPNVCPT(X,0),U),T,1)
- SET G=X
- +15 QUIT
- End DoDot:3
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 IF 'G
- QUIT ""
- +19 IF F=1
- QUIT $SELECT(G:1,1:"")
- +20 IF F=2
- QUIT G
- +21 IF F=3
- SET V=$PIECE(^AUPNVCPT(G,0),U,3)
- IF V
- QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
- +22 IF F=4
- SET V=$PIECE(^AUPNVCPT(G,0),U,3)
- IF V
- QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))
- +23 ;Patch 2 cvs changes
- +24 NEW APCHSVDT
- +25 ;I F=5 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^ICPT($P(^AUPNVCPT(G,0),U),0),U)
- +26 IF F=5
- SET V=$PIECE(^AUPNVCPT(G,0),U,3)
- IF V
- SET APCHSVDT=$PIECE(+V,".")
- QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")_"^"_$PIECE($$CPT^ICPTCOD($PIECE(^AUPNVCPT(G,0),U),APCHSVDT),U,2)
- +27 QUIT ""