HMP0311Q.m

HMP0311Q ;ASMR/MAT - HMP Subscribe Client Protocols to VAFC;10/1/2015 12:49pm

 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;November 30,2015;Build 63

 ;Per VA Directive 6402, this routine should not be modified.

 ;

 ; DE2393 - MAT - Subscribe HMP ADT-A0# CLIENT Protocol to VAFC ADT-A0# SERVER

 ;

 ; Called from POST^HMPP3I.

 Q

 ;

POST ;

 D MES^XPDUTL($T(+0)_" post-init routine started "_$$HTE^XLFDT($H))

 D MES^XPDUTL($$HMPA04())

 D MES^XPDUTL($$HMPA08())

 D MES^XPDUTL("HMP ADT-A0# CLIENT protocols subscribed "_$$HTE^XLFDT($H))

 Q

 ;

HMPA04() ;

 N HMPSUBS

 S HMPSUBS=$$PROTSUBS("HMP ADT-A04 CLIENT","VAFC ADT-A04 SERVER")

 Q HMPSUBS

 ;

HMPA08() ;

 N HMPSUBS

 S HMPSUBS=$$PROTSUBS("HMP ADT-A08 CLIENT","VAFC ADT-A08 SERVER")

 Q HMPSUBS

 ;

 ;=== Subscribe PROTSRC to PROTARG.

 ;

PROTSUBS(PROTSRC,PROTARG) ;

 ;

 ;--- Validate SOURCE and TARGET exist.

 N IENPSRC S IENPSRC=$$YNPROTO(PROTSRC)

 Q:IENPSRC=-1 "SOURCE PROTOCOL "_PROTSRC_" NOT FOUND."

 ;

 N IENPTRG S IENPTRG=$$YNPROTO(PROTARG)

 Q:IENPTRG=-1 "TARGET PROTOCOL "_PROTARG_" NOT FOUND."

 ;

 ;--- Validate SOURCE is not a subscriber of TARGET.

 N IENPSUB S IENPSUB=$$YNSUBSCR(PROTSRC,IENPTRG)

 Q:IENPSUB>0 "PROTOCOL "_PROTSRC_" ALREADY SUBSCRIBED TO "_PROTARG_"."

 ;

 ;--- Subscribe SOURCE to TARGET.

 N FDA S FDA(1,101.0775,"+1,"_IENPTRG_",",.01)=PROTSRC

 D UPDATE^DIE("E","FDA(1)")

 Q "PROTOCOL "_PROTSRC_" IS NOW SUBSCRIBED TO "_PROTARG_"."

 ;

 ;=== Return the PROTOCOL File IEN or -1 if not exist.

 ;

YNPROTO(PROTO) ;

 N DIC,X,Y S X=PROTO,DIC="^ORD(101," D ^DIC

 Q +Y

 ;

 ;=== Return the SUBSCRIBER Sub-File IEN or -1 if not exist.

 ;

YNSUBSCR(PROTSRC,IENPTRG) ;

 N DIC,X,Y S X=PROTSRC,DIC="^ORD(101,"_IENPTRG_",775," D ^DIC

 Q +Y

 ;

 ; HMP0311Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---HMP0311Q   1768     printed  Mar 13, 2025@20:57:34                                                                                                                                                                                                    Page 2

HMP0311Q  ;ASMR/MAT - HMP Subscribe Client Protocols to VAFC;10/1/2015 12:49pm

 +1       ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;November 30,2015;Build 63

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; DE2393 - MAT - Subscribe HMP ADT-A0# CLIENT Protocol to VAFC ADT-A0# SERVER

 +5       ;

 +6       ; Called from POST^HMPP3I.

 +7        QUIT 

 +8       ;

POST      ;

 +1        DO MES^XPDUTL($TEXT(+0)_" post-init routine started "_$$HTE^XLFDT($HOROLOG))

 +2        DO MES^XPDUTL($$HMPA04())

 +3        DO MES^XPDUTL($$HMPA08())

 +4        DO MES^XPDUTL("HMP ADT-A0# CLIENT protocols subscribed "_$$HTE^XLFDT($HOROLOG))

 +5        QUIT 

 +6       ;

HMPA04()  ;

 +1        NEW HMPSUBS

 +2        SET HMPSUBS=$$PROTSUBS("HMP ADT-A04 CLIENT","VAFC ADT-A04 SERVER")

 +3        QUIT HMPSUBS

 +4       ;

HMPA08()  ;

 +1        NEW HMPSUBS

 +2        SET HMPSUBS=$$PROTSUBS("HMP ADT-A08 CLIENT","VAFC ADT-A08 SERVER")

 +3        QUIT HMPSUBS

 +4       ;

 +5       ;=== Subscribe PROTSRC to PROTARG.

 +6       ;

PROTSUBS(PROTSRC,PROTARG) ;

 +1       ;

 +2       ;--- Validate SOURCE and TARGET exist.

 +3        NEW IENPSRC

           SET IENPSRC=$$YNPROTO(PROTSRC)

 +4        if IENPSRC=-1

               QUIT "SOURCE PROTOCOL "_PROTSRC_" NOT FOUND."

 +5       ;

 +6        NEW IENPTRG

           SET IENPTRG=$$YNPROTO(PROTARG)

 +7        if IENPTRG=-1

               QUIT "TARGET PROTOCOL "_PROTARG_" NOT FOUND."

 +8       ;

 +9       ;--- Validate SOURCE is not a subscriber of TARGET.

 +10       NEW IENPSUB

           SET IENPSUB=$$YNSUBSCR(PROTSRC,IENPTRG)

 +11       if IENPSUB>0

               QUIT "PROTOCOL "_PROTSRC_" ALREADY SUBSCRIBED TO "_PROTARG_"."

 +12      ;

 +13      ;--- Subscribe SOURCE to TARGET.

 +14       NEW FDA

           SET FDA(1,101.0775,"+1,"_IENPTRG_",",.01)=PROTSRC

 +15       DO UPDATE^DIE("E","FDA(1)")

 +16       QUIT "PROTOCOL "_PROTSRC_" IS NOW SUBSCRIBED TO "_PROTARG_"."

 +17      ;

 +18      ;=== Return the PROTOCOL File IEN or -1 if not exist.

 +19      ;

YNPROTO(PROTO) ;

 +1        NEW DIC,X,Y

           SET X=PROTO

           SET DIC="^ORD(101,"

           DO ^DIC

 +2        QUIT +Y

 +3       ;

 +4       ;=== Return the SUBSCRIBER Sub-File IEN or -1 if not exist.

 +5       ;

YNSUBSCR(PROTSRC,IENPTRG) ;

 +1        NEW DIC,X,Y

           SET X=PROTSRC

           SET DIC="^ORD(101,"_IENPTRG_",775,"

           DO ^DIC

 +2        QUIT +Y

 +3       ;

 +4       ; HMP0311Q