ACHSCEDT.m

ACHSCEDT ;IHS/ITSC/JVK - CHS CONTRACT TYPE EDIT [ 03/24/2005  7:49 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11,2001

 ;ITSC/SET/JVK 3/21/05 NEW ROUTINE

 ;EP EDIT THE LAST ALPHA DIGIT OF THE HHS PO NUM.

 W !!,?5,"THIS OPTION ALLOWS FOR CHS STAFF TO CORRECT THE CONTRACT",!

 W ?5,"ACTION TYPE DIGIT OF THE HHS NUMBER.",!

 D ^ACHSUD

 S ACHSDIEN=$P(Y,U)

 I 'ACHSDIEN Q

 N DA,DIC,DIE,DR

 S DIE="^ACHSF("_DUZ(2)_",""D"",",DA=ACHSDIEN,DR="64"

 D ^DIE

 Q

ACHSCEDT  ;IHS/ITSC/JVK - CHS CONTRACT TYPE EDIT [ 03/24/2005  7:49 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11,2001

 +2       ;ITSC/SET/JVK 3/21/05 NEW ROUTINE

 +3       ;EP EDIT THE LAST ALPHA DIGIT OF THE HHS PO NUM.

 +4        WRITE !!,?5,"THIS OPTION ALLOWS FOR CHS STAFF TO CORRECT THE CONTRACT",!

 +5        WRITE ?5,"ACTION TYPE DIGIT OF THE HHS NUMBER.",!

 +6        DO ^ACHSUD

 +7        SET ACHSDIEN=$PIECE(Y,U)

 +8        IF 'ACHSDIEN

               QUIT 

 +9        NEW DA,DIC,DIE,DR

 +10       SET DIE="^ACHSF("_DUZ(2)_",""D"","

           SET DA=ACHSDIEN

           SET DR="64"

 +11       DO ^DIE

 +12       QUIT