ADGPOST.m

ADGPOST ; IHS/ADC/PDW/ENM - ADT POSTINITS ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 ;searhc/maw removed call to adgcp which is the patient movement

 ;and provider conversion, this should be run at the end.

 ;

 ;D DS,^ADGCP,XREF Q

 D DS,XREF Q

 ;

DS ; day surgery service category fix

 ; -- changes all day surgeries to category "S"

 ; -- change is hard set so APCIS xref not triggered

 W !!!,"Converting day surgery visits to service category ""S""",!

 NEW DSDT,REVDT,DSIEN,DFN,VISIT,CODE

 S CODE=$O(^DIC(40.7,"C",44,0)) Q:CODE=""

 S DFN=0

 F  S DFN=$O(^ADGDS(DFN)) Q:'DFN  D

 . S DSIEN=0

 . F  S DSIEN=$O(^ADGDS(DFN,"DS",DSIEN)) Q:'DSIEN  D

 .. S X=$P($G(^ADGDS(DFN,"DS",DSIEN,2)),U) Q:X=""

 .. Q:'$D(^ADGDS(DFN,"DS",DSIEN,0))  S DATE=+^(0) Q:DATE<1

 .. S REVDT=9999999-$P(DATE,"."),REVDT=REVDT_"."_$P(DATE,".",2)

 .. ;

 .. S VISIT=0

 .. F  S VISIT=$O(^AUPNVSIT("AA",DFN,REVDT,VISIT)) Q:VISIT=""  D

 ... S X=$G(^AUPNVSIT(VISIT,0)) Q:X=""  Q:$P(X,U,8)'=CODE

 ... Q:$P(X,U,7)'="A"

 ... S $P(^AUPNVSIT(VISIT,0),U,7)="S" ;change serv cat to day surg

 Q

 ;

XREF ; -- reindex incomplete chart and ds incomplete chart files

 W !!,"Re-Indexing Incomplete Chart File..."

 S DIK="^ADGIC(" D IXALL^DIK

 W !!,"Re-Indexing DS Incomplete Chart File...",!

 S DIK="^ADGDSI(" D IXALL^DIK

 Q

ADGPOST   ; IHS/ADC/PDW/ENM - ADT POSTINITS ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3       ;searhc/maw removed call to adgcp which is the patient movement

 +4       ;and provider conversion, this should be run at the end.

 +5       ;

 +6       ;D DS,^ADGCP,XREF Q

 +7        DO DS

           DO XREF

           QUIT 

 +8       ;

DS        ; day surgery service category fix

 +1       ; -- changes all day surgeries to category "S"

 +2       ; -- change is hard set so APCIS xref not triggered

 +3        WRITE !!!,"Converting day surgery visits to service category ""S""",!

 +4        NEW DSDT,REVDT,DSIEN,DFN,VISIT,CODE

 +5        SET CODE=$ORDER(^DIC(40.7,"C",44,0))

           IF CODE=""

               QUIT 

 +6        SET DFN=0

 +7        FOR 

               SET DFN=$ORDER(^ADGDS(DFN))

               IF 'DFN

                   QUIT 

               Begin DoDot:1

 +8                SET DSIEN=0

 +9                FOR 

                       SET DSIEN=$ORDER(^ADGDS(DFN,"DS",DSIEN))

                       IF 'DSIEN

                           QUIT 

                       Begin DoDot:2

 +10                       SET X=$PIECE($GET(^ADGDS(DFN,"DS",DSIEN,2)),U)

                           IF X=""

                               QUIT 

 +11                       IF '$DATA(^ADGDS(DFN,"DS",DSIEN,0))

                               QUIT 

                           SET DATE=+^(0)

                           IF DATE<1

                               QUIT 

 +12                       SET REVDT=9999999-$PIECE(DATE,".")

                           SET REVDT=REVDT_"."_$PIECE(DATE,".",2)

 +13      ;

 +14                       SET VISIT=0

 +15                       FOR 

                               SET VISIT=$ORDER(^AUPNVSIT("AA",DFN,REVDT,VISIT))

                               IF VISIT=""

                                   QUIT 

                               Begin DoDot:3

 +16                               SET X=$GET(^AUPNVSIT(VISIT,0))

                                   IF X=""

                                       QUIT 

                                   IF $PIECE(X,U,8)'=CODE

                                       QUIT 

 +17                               IF $PIECE(X,U,7)'="A"

                                       QUIT 

 +18      ;change serv cat to day surg

                                   SET $PIECE(^AUPNVSIT(VISIT,0),U,7)="S"

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +19       QUIT 

 +20      ;

XREF      ; -- reindex incomplete chart and ds incomplete chart files

 +1        WRITE !!,"Re-Indexing Incomplete Chart File..."

 +2        SET DIK="^ADGIC("

           DO IXALL^DIK

 +3        WRITE !!,"Re-Indexing DS Incomplete Chart File...",!

 +4        SET DIK="^ADGDSI("

           DO IXALL^DIK

 +5        QUIT