AUMDO1D.m

AUMDO1D ;IHS/OIRM/DSD/AEF - UPDATE PCC DATA ENTRY INPT EDITS FILE [ 12/03/1998   2:35 PM ]

 ;;99.1;ICD UPDATE;;DEC 03, 1998

 ;

 Q

EN(UPD,ICD)        ;EP

 ;----- MAIN ENTRY POINT TO ADD ICD9 CODES TO THE PCC DATA ENTRY

 ;      INPT EDITS FILE

 ;

 ;      UPD  = ICD UPDATES FILE ENTRY INTERNAL NUMBER

 ;      ICD  = ICD DIAGNOSIS FILE ENTRY INTERNAL NUMBER

 ;

 N COND,CONDX

 S CONDX=0 F  S CONDX=$O(^AUMDDTMP(UPD,"PCC",CONDX)) Q:'CONDX  D

 . S COND=$P($G(^AUMDDTMP(UPD,"PCC",CONDX,0)),U)

 . Q:COND']""

 . D ONE(COND,ICD)

 Q

ONE(COND,ICD)      ;

 ;----- UPDATE ONE ENTRY

 ;

 N DA,DD,DIC,DIE,DO,DR,X,Y

 Q:'$D(^APCDINPT("B",COND))

 S DA(1)=$O(^APCDINPT("B",COND,0))

 Q:'DA(1)

 Q:$D(^APCDINPT(DA(1),11,"B",ICD))

 K DD,DO

 S DIC="^APCDINPT("_DA(1)_",11,"

 S DIC(0)="L"

 S DIC("P")=$P(^DD(9001001.4,1101,0),U,2)

 S X=ICD

 D FILE^DICN

 Q:Y'>0

 S DA=+Y

 S DIE=DIC

 S DR=".02////"_$P(^ICD9(ICD,0),U)

 D ^DIE

 Q

AUMDO1D   ;IHS/OIRM/DSD/AEF - UPDATE PCC DATA ENTRY INPT EDITS FILE [ 12/03/1998   2:35 PM ]

 +1       ;;99.1;ICD UPDATE;;DEC 03, 1998

 +2       ;

 +3        QUIT 

EN(UPD,ICD) ;EP

 +1       ;----- MAIN ENTRY POINT TO ADD ICD9 CODES TO THE PCC DATA ENTRY

 +2       ;      INPT EDITS FILE

 +3       ;

 +4       ;      UPD  = ICD UPDATES FILE ENTRY INTERNAL NUMBER

 +5       ;      ICD  = ICD DIAGNOSIS FILE ENTRY INTERNAL NUMBER

 +6       ;

 +7        NEW COND,CONDX

 +8        SET CONDX=0

           FOR 

               SET CONDX=$ORDER(^AUMDDTMP(UPD,"PCC",CONDX))

               IF 'CONDX

                   QUIT 

               Begin DoDot:1

 +9                SET COND=$PIECE($GET(^AUMDDTMP(UPD,"PCC",CONDX,0)),U)

 +10               IF COND']""

                       QUIT 

 +11               DO ONE(COND,ICD)

               End DoDot:1

 +12       QUIT 

ONE(COND,ICD) ;

 +1       ;----- UPDATE ONE ENTRY

 +2       ;

 +3        NEW DA,DD,DIC,DIE,DO,DR,X,Y

 +4        IF '$DATA(^APCDINPT("B",COND))

               QUIT 

 +5        SET DA(1)=$ORDER(^APCDINPT("B",COND,0))

 +6        IF 'DA(1)

               QUIT 

 +7        IF $DATA(^APCDINPT(DA(1),11,"B",ICD))

               QUIT 

 +8        KILL DD,DO

 +9        SET DIC="^APCDINPT("_DA(1)_",11,"

 +10       SET DIC(0)="L"

 +11       SET DIC("P")=$PIECE(^DD(9001001.4,1101,0),U,2)

 +12       SET X=ICD

 +13       DO FILE^DICN

 +14       IF Y'>0

               QUIT 

 +15       SET DA=+Y

 +16       SET DIE=DIC

 +17       SET DR=".02////"_$PIECE(^ICD9(ICD,0),U)

 +18       DO ^DIE

 +19       QUIT