- ADEUPD33 ;IHS/OIT/GAB - ADE6.0 PATCH 33 [ 11/09/2018 14:05 PM ]
- ;;6.0;ADE;**33**;March 25, 1999;Build 53
- ;IHS/OIT/GAB 10/2018 Patch 33 ADA-CDT code updates for 2019
- ;Utility routine to update the ADA Code file
- UPDATE(ADEFILE,ADEFLDS,ADEWPFLD,ADEIENST,ADETGRTN,ADESETX) ;EP
- N ADEFDA
- S ADENFLDS=$L(ADEFLDS,","),ADEDONE=0,ADERPEAT=0,ADEN="",ADETXT=0
- F ADEI=1:1 S ADEX=$P($T(@$P(ADETGRTN,"^")+ADEI^@$P(ADETGRTN,"^",2)),";;",2) S:ADEX="***END***" ADEDONE=1 D Q:ADEDONE
- .I ADEX[U!ADEDONE D K ADETEXT S ADETXT=0 Q
- ..F D Q:ADERPEAT<2
- ...S ADELSTN=ADEN D:ADESETX'="" @ADESETX D:ADELSTN]"" FILE D SETFDA Q
- .Q:$G(ADEWPFLD)=""
- .S ADETXT=ADETXT+1,ADETEXT(ADETXT)=ADEX
- K ADECURX,ADEDONE,ADEI,ADEI1,ADELSTN,ADEN,ADEEND,ADENFLDS,ADERPEAT,ADESVX,ADESTART,ADETXT,ADETEXT,ADEX,ADEX1
- Q
- ;
- SETFDA ;EP
- ; Corresponds to values in X: the first is the field that is set with the first piece, etc. If a value isn't used to set a field
- ; nothing should be entered for that piece; should be left empty e.g. ".01,02,,.09"
- F ADEI1=1:1:ADENFLDS S ADEFLD=$P(ADEFLDS,",",ADEI1) I ADEFLD'="" S ADEX1=$P(ADEX,U,ADEI1) S:ADEX1'="" ADEFDA(ADEFILE,ADEIENST,ADEFLD)=ADEX1
- S ADEN=$P(ADEX,U)
- Q
- ;
- FILE ;EP
- D UPDATE^DIE(,"ADEFDA","ADEIEN","ADEEMSG")
- K ADEFDA,ADEEMSG
- ; get the IEN assigned
- I +$G(ADEIEN(1)),$G(ADETEXT(1))'="" D WP^DIE(ADEFILE,ADEIEN(1)_",",ADEWPFLD,,"ADETEXT","ADEEMSG")
- K ADEEMSG,ADEIEN
- Q
- ;
- DELETES(ADETGRTN,ADESETX,ADEDIK) ;EP
- F ADEI=1:1 S ADEX=$P($T(@$P(ADETGRTN,"^")+ADEI^@$P(ADETGRTN,"^",2)),";;",2) Q:ADEX="***END***" D
- . D:ADESETX'="" @ADESETX
- . I ADEX'="" S DA=ADEX,DIE=ADEDIK,DR=".08////3190101" D ^DIE
- . Q
- Q
- ADEUPD33 ;IHS/OIT/GAB - ADE6.0 PATCH 33 [ 11/09/2018 14:05 PM ]
- +1 ;;6.0;ADE;**33**;March 25, 1999;Build 53
- +2 ;IHS/OIT/GAB 10/2018 Patch 33 ADA-CDT code updates for 2019
- +3 ;Utility routine to update the ADA Code file
- UPDATE(ADEFILE,ADEFLDS,ADEWPFLD,ADEIENST,ADETGRTN,ADESETX) ;EP
- +1 NEW ADEFDA
- +2 SET ADENFLDS=$LENGTH(ADEFLDS,",")
- SET ADEDONE=0
- SET ADERPEAT=0
- SET ADEN=""
- SET ADETXT=0
- +3 FOR ADEI=1:1
- SET ADEX=$PIECE($TEXT(@$PIECE(ADETGRTN,"^")+ADEI^@$PIECE(ADETGRTN,"^",2)),";;",2)
- IF ADEX="***END***"
- SET ADEDONE=1
- Begin DoDot:1
- +4 IF ADEX[U!ADEDONE
- Begin DoDot:2
- +5 FOR
- Begin DoDot:3
- +6 SET ADELSTN=ADEN
- IF ADESETX'=""
- DO @ADESETX
- IF ADELSTN]""
- DO FILE
- DO SETFDA
- QUIT
- End DoDot:3
- IF ADERPEAT<2
- QUIT
- End DoDot:2
- KILL ADETEXT
- SET ADETXT=0
- QUIT
- +7 IF $GET(ADEWPFLD)=""
- QUIT
- +8 SET ADETXT=ADETXT+1
- SET ADETEXT(ADETXT)=ADEX
- End DoDot:1
- IF ADEDONE
- QUIT
- +9 KILL ADECURX,ADEDONE,ADEI,ADEI1,ADELSTN,ADEN,ADEEND,ADENFLDS,ADERPEAT,ADESVX,ADESTART,ADETXT,ADETEXT,ADEX,ADEX1
- +10 QUIT
- +11 ;
- SETFDA ;EP
- +1 ; Corresponds to values in X: the first is the field that is set with the first piece, etc. If a value isn't used to set a field
- +2 ; nothing should be entered for that piece; should be left empty e.g. ".01,02,,.09"
- +3 FOR ADEI1=1:1:ADENFLDS
- SET ADEFLD=$PIECE(ADEFLDS,",",ADEI1)
- IF ADEFLD'=""
- SET ADEX1=$PIECE(ADEX,U,ADEI1)
- IF ADEX1'=""
- SET ADEFDA(ADEFILE,ADEIENST,ADEFLD)=ADEX1
- +4 SET ADEN=$PIECE(ADEX,U)
- +5 QUIT
- +6 ;
- FILE ;EP
- +1 DO UPDATE^DIE(,"ADEFDA","ADEIEN","ADEEMSG")
- +2 KILL ADEFDA,ADEEMSG
- +3 ; get the IEN assigned
- +4 IF +$GET(ADEIEN(1))
- IF $GET(ADETEXT(1))'=""
- DO WP^DIE(ADEFILE,ADEIEN(1)_",",ADEWPFLD,,"ADETEXT","ADEEMSG")
- +5 KILL ADEEMSG,ADEIEN
- +6 QUIT
- +7 ;
- DELETES(ADETGRTN,ADESETX,ADEDIK) ;EP
- +1 FOR ADEI=1:1
- SET ADEX=$PIECE($TEXT(@$PIECE(ADETGRTN,"^")+ADEI^@$PIECE(ADETGRTN,"^",2)),";;",2)
- IF ADEX="***END***"
- QUIT
- Begin DoDot:1
- +2 IF ADESETX'=""
- DO @ADESETX
- +3 IF ADEX'=""
- SET DA=ADEX
- SET DIE=ADEDIK
- SET DR=".08////3190101"
- DO ^DIE
- +4 QUIT
- End DoDot:1
- +5 QUIT