ATXPAT.m

ATXPAT ; IHS/OHPRD/TMJ -  ENTER/EDIT PAT TAX FILE ; 

 ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48

 ;

 Q:$D(ATXQT)

 ;

START ;

 D INIT

 I '$D(^ATXAX(ATXDT,0))!('$D(^ATXPAT(ATXDT,0))#2) D EOJ Q

 S ATXPV=0

 F ATXL=0:0 S ATXPV=$O(^AUPNVPOV("B",ATXDI,ATXPV)) Q:ATXPV'=+ATXPV  S ATXPD=$P(^AUPNVPOV(ATXPV,0),U,2),ATXVIS=$P(^(0),U,3),ATXVIS=$P(^AUPNVSIT(ATXVIS,0),U) D @$S($D(ATXAD):"DIEADD",1:"DIEDEL")

 D EOJ

 Q

 ;

INIT ;

 S ATXDI=DA(1) ;DFN OF THE ICD CODE

 S ATXDT=DA ;DFN OF THE TAXONOMY

 Q

 ;

DIEADD ; ENTRY POINT - ADD PT TO PT TAXONOMY FILE FOR THIS TAXONOMY

 Q:'$D(^ATXPAT(ATXDT,0))#2

 I $P(^ATXAX(ATXDT,0),U,6)="" Q

 I ATXVIS<$P(^ATXAX(ATXDT,0),U,6) Q

 I '$P(^ATXAX(ATXDT,0),U,18)

 E  S ATXLV=$P(^AUPNVSIT(ATXVISDA,0),U,6) I ATXLV'=$P(^ATXAX(ATXDT,0),U,18) Q

 I $D(^ATXPAT(ATXDT,11,ATXPD)) S $P(^(0),U,2)=$P(^(ATXPD,0),U,2)+1 Q

 S ^ATXPAT(ATXDT,11,ATXPD,0)=ATXPD_"^1"

 S $P(^ATXPAT(ATXDT,11,0),U,3)=ATXPD,$P(^(0),U,4)=$P(^(0),U,4)+1

 NEW (DT,DTIME,DUZ,IO,IOF,IOM,IOS,IOSL,IOXY,U,XQDIC,XQPSM,XQY,IOST,XQYO,ZTQUEUED,ATXPD,ATXDT) D

 . S DA=ATXPD,DA(1)=ATXDT,DIK="^ATXPAT(ATXDT,11," D IX1^DIK K DIK,DA

 Q

 ;

DIEDEL ; ENTRY POINT - SUBTRACT ONE FROM VISIT COUNTER; IF 0, DELETE PT

 Q:'$D(^ATXPAT(ATXDT,0))#2

 Q:'$D(^ATXPAT(ATXDT,11,ATXPD,0))

 I $P(^ATXAX(ATXDT,0),U,6)="" Q

 I ATXVIS<$P(^ATXAX(ATXDT,0),U,6) Q

 S $P(^(0),U,2)=$P(^ATXPAT(ATXDT,11,ATXPD,0),U,2)-1

 I $P(^ATXPAT(ATXDT,11,ATXPD,0),U,2) Q

 NEW (DT,DTIME,DUZ,IO,IOF,IOM,IOS,IOSL,IOXY,U,XQDIC,XQPSM,XQY,IOST,XQYO,ZTQUEUED,ATXPD,ATXDT) D

 . S DA=ATXPD,DA(1)=ATXDT,DIK="^ATXPAT(ATXDT,11," D ^DIK K DIK,DA

 Q

 ;

EOJ ;

 K ATXPV,ATXDI,ATXDT,ATXAD,ATXH,ATXY,ATXPD,ATXLV

 Q

 ;

ATXPAT    ; IHS/OHPRD/TMJ -  ENTER/EDIT PAT TAX FILE ; 

 +1       ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48

 +2       ;

 +3        IF $DATA(ATXQT)

               QUIT 

 +4       ;

START     ;

 +1        DO INIT

 +2        IF '$DATA(^ATXAX(ATXDT,0))!('$DATA(^ATXPAT(ATXDT,0))#2)

               DO EOJ

               QUIT 

 +3        SET ATXPV=0

 +4        FOR ATXL=0:0

               SET ATXPV=$ORDER(^AUPNVPOV("B",ATXDI,ATXPV))

               IF ATXPV'=+ATXPV

                   QUIT 

               SET ATXPD=$PIECE(^AUPNVPOV(ATXPV,0),U,2)

               SET ATXVIS=$PIECE(^(0),U,3)

               SET ATXVIS=$PIECE(^AUPNVSIT(ATXVIS,0),U)

               DO @$SELECT($DATA(ATXAD):"DIEADD",1:"DIEDEL")

 +5        DO EOJ

 +6        QUIT 

 +7       ;

INIT      ;

 +1       ;DFN OF THE ICD CODE

           SET ATXDI=DA(1)

 +2       ;DFN OF THE TAXONOMY

           SET ATXDT=DA

 +3        QUIT 

 +4       ;

DIEADD    ; ENTRY POINT - ADD PT TO PT TAXONOMY FILE FOR THIS TAXONOMY

 +1        IF '$DATA(^ATXPAT(ATXDT,0))#2

               QUIT 

 +2        IF $PIECE(^ATXAX(ATXDT,0),U,6)=""

               QUIT 

 +3        IF ATXVIS<$PIECE(^ATXAX(ATXDT,0),U,6)

               QUIT 

 +4        IF '$PIECE(^ATXAX(ATXDT,0),U,18)

 +5       IF '$TEST

               SET ATXLV=$PIECE(^AUPNVSIT(ATXVISDA,0),U,6)

               IF ATXLV'=$PIECE(^ATXAX(ATXDT,0),U,18)

                   QUIT 

 +6        IF $DATA(^ATXPAT(ATXDT,11,ATXPD))

               SET $PIECE(^(0),U,2)=$PIECE(^(ATXPD,0),U,2)+1

               QUIT 

 +7        SET ^ATXPAT(ATXDT,11,ATXPD,0)=ATXPD_"^1"

 +8        SET $PIECE(^ATXPAT(ATXDT,11,0),U,3)=ATXPD

           SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

 +9        NEW (DT,DTIME,DUZ,IO,IOF,IOM,IOS,IOSL,IOXY,U,XQDIC,XQPSM,XQY,IOST,XQYO,ZTQUEUED,ATXPD,ATXDT)

           Begin DoDot:1

 +10           SET DA=ATXPD

               SET DA(1)=ATXDT

               SET DIK="^ATXPAT(ATXDT,11,"

               DO IX1^DIK

               KILL DIK,DA

           End DoDot:1

 +11       QUIT 

 +12      ;

DIEDEL    ; ENTRY POINT - SUBTRACT ONE FROM VISIT COUNTER; IF 0, DELETE PT

 +1        IF '$DATA(^ATXPAT(ATXDT,0))#2

               QUIT 

 +2        IF '$DATA(^ATXPAT(ATXDT,11,ATXPD,0))

               QUIT 

 +3        IF $PIECE(^ATXAX(ATXDT,0),U,6)=""

               QUIT 

 +4        IF ATXVIS<$PIECE(^ATXAX(ATXDT,0),U,6)

               QUIT 

 +5        SET $PIECE(^(0),U,2)=$PIECE(^ATXPAT(ATXDT,11,ATXPD,0),U,2)-1

 +6        IF $PIECE(^ATXPAT(ATXDT,11,ATXPD,0),U,2)

               QUIT 

 +7        NEW (DT,DTIME,DUZ,IO,IOF,IOM,IOS,IOSL,IOXY,U,XQDIC,XQPSM,XQY,IOST,XQYO,ZTQUEUED,ATXPD,ATXDT)

           Begin DoDot:1

 +8            SET DA=ATXPD

               SET DA(1)=ATXDT

               SET DIK="^ATXPAT(ATXDT,11,"

               DO ^DIK

               KILL DIK,DA

           End DoDot:1

 +9        QUIT 

 +10      ;

EOJ       ;

 +1        KILL ATXPV,ATXDI,ATXDT,ATXAD,ATXH,ATXY,ATXPD,ATXLV

 +2        QUIT 

 +3       ;