- ACMFIX ;Fix Dt of Onset - Pat Lundgren - IHS Diabetes Register [ 03/16/01 2:47 PM ]
- ;This routine $O thru ACM(41 CMS REGISTER finds only IHS Diabetes
- ;Entries - Sets the HXDT to field 20 Date of Onset & stuffs this
- ;date in the ACM(44 CMS Diagnosis for the Client, if missing
- ;the Date of onset
- ;
- START ;$O ^ACM(41,"B",3 - IHS DIABETES REGISTER ONLY
- S REG="" F S REG=$O(^ACM(41,"B",REG)) Q:REG'=+REG D
- . Q:REG'=3879
- . S REGIEN="" F S REGIEN=$O(^ACM(41,"B",REG,REGIEN)) Q:REGIEN'=+REGIEN D
- .. S HXDT=$P($G(^ACM(41,REGIEN,"CH")),U,1)
- .. S HXPT=$P($G(^ACM(41,REGIEN,0)),U,2)
- .. Q:HXPT=""
- .. Q:HXDT=""
- .. ;Q:$P(^ACM(44,DXIEN,0)U,1)'=3 D
- .. S DXIEN=$O(^ACM(44,"C",+HXPT,0)) I 'DXIEN Q
- .. S DXDT=$P($G(^ACM(44,DXIEN,"SV")),U,2)
- .. I DXDT="" S DIE="^ACM(44,",DA=DXIEN,DR="2////"_HXDT D ^DIE K DIE,DR,DA
- ;
- ;
- ACMFIX ;Fix Dt of Onset - Pat Lundgren - IHS Diabetes Register [ 03/16/01 2:47 PM ]
- +1 ;This routine $O thru ACM(41 CMS REGISTER finds only IHS Diabetes
- +2 ;Entries - Sets the HXDT to field 20 Date of Onset & stuffs this
- +3 ;date in the ACM(44 CMS Diagnosis for the Client, if missing
- +4 ;the Date of onset
- +5 ;
- START ;$O ^ACM(41,"B",3 - IHS DIABETES REGISTER ONLY
- +1 SET REG=""
- FOR
- SET REG=$ORDER(^ACM(41,"B",REG))
- IF REG'=+REG
- QUIT
- Begin DoDot:1
- +2 IF REG'=3879
- QUIT
- +3 SET REGIEN=""
- FOR
- SET REGIEN=$ORDER(^ACM(41,"B",REG,REGIEN))
- IF REGIEN'=+REGIEN
- QUIT
- Begin DoDot:2
- +4 SET HXDT=$PIECE($GET(^ACM(41,REGIEN,"CH")),U,1)
- +5 SET HXPT=$PIECE($GET(^ACM(41,REGIEN,0)),U,2)
- +6 IF HXPT=""
- QUIT
- +7 IF HXDT=""
- QUIT
- +8 ;Q:$P(^ACM(44,DXIEN,0)U,1)'=3 D
- +9 SET DXIEN=$ORDER(^ACM(44,"C",+HXPT,0))
- IF 'DXIEN
- QUIT
- +10 SET DXDT=$PIECE($GET(^ACM(44,DXIEN,"SV")),U,2)
- +11 IF DXDT=""
- SET DIE="^ACM(44,"
- SET DA=DXIEN
- SET DR="2////"_HXDT
- DO ^DIE
- KILL DIE,DR,DA
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 ;