SD53P534 ; ALB/ESW - POST INSTALL; 2/11/03 12:49pm
;;5.3;Scheduling;**534**;AUG 13, 1993;Build 8
;
Q
POST ;
; Add/edit PCMM HL7 ERROR CODE '850'
N DIC,DIE,DA,DLAYGO,DR,X,Y,SDARRY,SDIENS
S DIC="^SCPT(404.472,",DIC(0)=""
S X="850"
D ^DIC I Y>0 D Q
. D BMES^XPDUTL("*****")
. D MES^XPDUTL("Unsuccessful update! ** Code 850 already exists. **")
. D MES^XPDUTL("*****")
.; S XPDABORT=2 <----disable abort; send only a message
S DIC="^SCPT(404.472,",DIC(0)="" D FILE^DICN
S DA=+Y,DR=".02///PV1;.03///4;.04///Admit type is invalid (table SD009)"
S SDIENS=+Y_","
S DIE=DIC D ^DIE
S SDARRY(1)="Error code indicates that the Admission Type does not match values from"
S SDARRY(2)="the Table SD009 - Purpose of Visit & appointment Type."
D WP^DIE(404.472,SDIENS,10,"","SDARRY")
D BMES^XPDUTL("*****")
D MES^XPDUTL(" The PCMM HL7 ERROR CODE (#404.472) File has been updated")
D MES^XPDUTL(" with the '850' Error Code.")
D MES^XPDUTL("*****")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P534 989 printed Nov 22, 2024@17:56:25 Page 2
SD53P534 ; ALB/ESW - POST INSTALL; 2/11/03 12:49pm
+1 ;;5.3;Scheduling;**534**;AUG 13, 1993;Build 8
+2 ;
+3 QUIT
POST ;
+1 ; Add/edit PCMM HL7 ERROR CODE '850'
+2 NEW DIC,DIE,DA,DLAYGO,DR,X,Y,SDARRY,SDIENS
+3 SET DIC="^SCPT(404.472,"
SET DIC(0)=""
+4 SET X="850"
+5 DO ^DIC
IF Y>0
Begin DoDot:1
+6 DO BMES^XPDUTL("*****")
+7 DO MES^XPDUTL("Unsuccessful update! ** Code 850 already exists. **")
+8 DO MES^XPDUTL("*****")
+9 ; S XPDABORT=2 <----disable abort; send only a message
End DoDot:1
QUIT
+10 SET DIC="^SCPT(404.472,"
SET DIC(0)=""
DO FILE^DICN
+11 SET DA=+Y
SET DR=".02///PV1;.03///4;.04///Admit type is invalid (table SD009)"
+12 SET SDIENS=+Y_","
+13 SET DIE=DIC
DO ^DIE
+14 SET SDARRY(1)="Error code indicates that the Admission Type does not match values from"
+15 SET SDARRY(2)="the Table SD009 - Purpose of Visit & appointment Type."
+16 DO WP^DIE(404.472,SDIENS,10,"","SDARRY")
+17 DO BMES^XPDUTL("*****")
+18 DO MES^XPDUTL(" The PCMM HL7 ERROR CODE (#404.472) File has been updated")
+19 DO MES^XPDUTL(" with the '850' Error Code.")
+20 DO MES^XPDUTL("*****")
+21 QUIT
