- 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
