ADGPCAC2 ; IHS/ADC/PDW/ENM - ADT/PCC DATE ENTRY-POV ; [ 03/25/1999 11:48 AM ]
;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1008**;MAR 25, 1999
;
;cmi/anch/maw 12/7/2007 patch 1008 add code set versioning 2,POV
;
A ; -- driver
D L2 Q:$D(DIRUT)
D ^ADGPCAC3 Q
;
L2 ; -- loop v pov
N IFN,N
Q:'$D(^AUPNVPOV("AD",DGVI))
W @IOF," (2) POV "
S IFN=0 F S IFN=$O(^AUPNVPOV("AD",DGVI,IFN)) Q:'IFN D 2 Q:$D(DIRUT)
Q:$D(DIRUT) D Q Q
;
2 ; -- display purpose of visit info
Q:'$D(^AUPNVPOV(IFN,0)) S N=$G(^(0))
W !!?6,"POV (Diagnosis): ",$$POV
W !?12,"Narrative: ",$$NAR,!?13,"Modifier: ",$$MOD
W ?47,"Cause of DX: ",$$CDX,!?4,"Primary/Secondary: ",$$PRI
N X S X=$P(N,U,9) Q:'X
;W !?6,"Cause of Injury: ",$P(^ICD9(X,0),U,3)
W !?6,"Cause of Injury: ",$P($$ICDDX^ICDCODE(X),U,4)
W !?4,"Place of Accident: ",$$PLC
W ?44,"Date of Injury: ",$$IDT
NEW X I $P(N,U,17)]"" W !?4,"Date of Onset: ",$$ONDT
; -- form feed?
W ! Q:($Y+4)'>IOSL S DIR(0)="E" D ^DIR K DIR,X W @IOF Q
;
Q ; -- cleanup
K DIR W ! S DIR(0)="E" D ^DIR K DIR,X W @IOF Q
;
POV() ; -- POV (Diagnosis)
;Q $P($G(^ICD9(+N,0)),U)_" "_$E($P($G(^ICD9(+N,0)),U,3),1,44)
Q $P($$ICDDX^ICDCODE(+N),U,2)_" "_$E($P($$ICDDX^ICDCODE(+N),U,4),1,44)
;
NAR() ; -- provider narrative
Q $P($G(^AUTNPOV(+$P(N,U,4),0)),U)
;
MOD() ; -- modifier
N Y,C S Y=$P(N,U,6) S C=$P(^DD(9000010.07,.06,0),U,2) D Y^DIQ Q Y
;
CDX() ; -- cause of dx
N Y,C S Y=$P(N,U,7) S C=$P(^DD(9000010.07,.07,0),U,2) D Y^DIQ Q Y
;
PRI() ; -- primary/secondary
N Y,C S Y=$P(N,U,12) S C=$P(^DD(9000010.07,.12,0),U,2) D Y^DIQ Q Y
;
PLC() ; -- place of accident
N Y,C S Y=$P(N,U,11) S C=$P(^DD(9000010.07,.11,0),U,2) D Y^DIQ Q Y
;
IDT() ; -- date of injury
N X S X=$P(N,U,13) Q:'X "" Q $E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
;
ONDT() ; -- date of onset
N Y S Y=$P(N,U,17) D DD^%DT Q Y
ADGPCAC2 ; IHS/ADC/PDW/ENM - ADT/PCC DATE ENTRY-POV ; [ 03/25/1999 11:48 AM ]
+1 ;;5.3;ADMISSION/DISCHARGE/TRANSFER;**1008**;MAR 25, 1999
+2 ;
+3 ;cmi/anch/maw 12/7/2007 patch 1008 add code set versioning 2,POV
+4 ;
A ; -- driver
+1 DO L2
IF $DATA(DIRUT)
QUIT
+2 DO ^ADGPCAC3
QUIT
+3 ;
L2 ; -- loop v pov
+1 NEW IFN,N
+2 IF '$DATA(^AUPNVPOV("AD",DGVI))
QUIT
+3 WRITE @IOF," (2) POV "
+4 SET IFN=0
FOR
SET IFN=$ORDER(^AUPNVPOV("AD",DGVI,IFN))
IF 'IFN
QUIT
DO 2
IF $DATA(DIRUT)
QUIT
+5 IF $DATA(DIRUT)
QUIT
DO Q
QUIT
+6 ;
2 ; -- display purpose of visit info
+1 IF '$DATA(^AUPNVPOV(IFN,0))
QUIT
SET N=$GET(^(0))
+2 WRITE !!?6,"POV (Diagnosis): ",$$POV
+3 WRITE !?12,"Narrative: ",$$NAR,!?13,"Modifier: ",$$MOD
+4 WRITE ?47,"Cause of DX: ",$$CDX,!?4,"Primary/Secondary: ",$$PRI
+5 NEW X
SET X=$PIECE(N,U,9)
IF 'X
QUIT
+6 ;W !?6,"Cause of Injury: ",$P(^ICD9(X,0),U,3)
+7 WRITE !?6,"Cause of Injury: ",$PIECE($$ICDDX^ICDCODE(X),U,4)
+8 WRITE !?4,"Place of Accident: ",$$PLC
+9 WRITE ?44,"Date of Injury: ",$$IDT
+10 NEW X
IF $PIECE(N,U,17)]""
WRITE !?4,"Date of Onset: ",$$ONDT
+11 ; -- form feed?
+12 WRITE !
IF ($Y+4)'>IOSL
QUIT
SET DIR(0)="E"
DO ^DIR
KILL DIR,X
WRITE @IOF
QUIT
+13 ;
Q ; -- cleanup
+1 KILL DIR
WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR,X
WRITE @IOF
QUIT
+2 ;
POV() ; -- POV (Diagnosis)
+1 ;Q $P($G(^ICD9(+N,0)),U)_" "_$E($P($G(^ICD9(+N,0)),U,3),1,44)
+2 QUIT $PIECE($$ICDDX^ICDCODE(+N),U,2)_" "_$EXTRACT($PIECE($$ICDDX^ICDCODE(+N),U,4),1,44)
+3 ;
NAR() ; -- provider narrative
+1 QUIT $PIECE($GET(^AUTNPOV(+$PIECE(N,U,4),0)),U)
+2 ;
MOD() ; -- modifier
+1 NEW Y,C
SET Y=$PIECE(N,U,6)
SET C=$PIECE(^DD(9000010.07,.06,0),U,2)
DO Y^DIQ
QUIT Y
+2 ;
CDX() ; -- cause of dx
+1 NEW Y,C
SET Y=$PIECE(N,U,7)
SET C=$PIECE(^DD(9000010.07,.07,0),U,2)
DO Y^DIQ
QUIT Y
+2 ;
PRI() ; -- primary/secondary
+1 NEW Y,C
SET Y=$PIECE(N,U,12)
SET C=$PIECE(^DD(9000010.07,.12,0),U,2)
DO Y^DIQ
QUIT Y
+2 ;
PLC() ; -- place of accident
+1 NEW Y,C
SET Y=$PIECE(N,U,11)
SET C=$PIECE(^DD(9000010.07,.11,0),U,2)
DO Y^DIQ
QUIT Y
+2 ;
IDT() ; -- date of injury
+1 NEW X
SET X=$PIECE(N,U,13)
IF 'X
QUIT ""
QUIT $EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)_"-"_$EXTRACT(X,2,3)
+2 ;
ONDT() ; -- date of onset
+1 NEW Y
SET Y=$PIECE(N,U,17)
DO DD^%DT
QUIT Y
