ECX150PT.m

ECX150PT ;ALB/AG-ECX*3.0*150 Post-Init RTN ; 4/7/14 12:05pm

 ;;3.0;DSS EXTRACTS;**150**;;Build 3

 ;

 ;Post-init routine adding new entries and updating current entries to

 ;NATIONAL CLINIC (#728.441) file

 ;

 Q

 ;

EN ;routine entry point

 D UNLOCK     ;unlock Data Dictionary to allow changes

 D UPDATE     ;change name to existing Clinic codes

 D INACT^ECX150P1

 D INACT^ECX150P2

 D LOCK       ;lock Data Dictionary to restrict changes

 Q

 ;

UNLOCK ;

 K ^DD(728.441,.01,7.5)

 N ECXI

 F ECXI=.01,1,3 S $P(^DD(728.441,ECXI,0),"^",2)=$TR($P(^DD(728.441,ECXI,0),"^",2),"I","")

 Q

UPDATE ;changing short description of existing clinic

 N ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,ECXI,ECXREC

 D BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file..")

 I $P(^DD(728.441,.01,0),"^",2)["I" D  Q

 .D BMES^XPDUTL(">>Unable to update File 728.441, it is locked")

 .D BMES^XPDUTL("Contact support for assistance")

 F ECXI=1:1 S ECXREC=$P($T(UPDCLIN+ECXI),";;",2) Q:ECXREC="QUIT"  D

 .S ECXCODE=$P(ECXREC,"^"),ECXDESC=$P(ECXREC,"^",2)

 .S ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")

 .I 'ECXIEN D  Q

 ..D BMES^XPDUTL(">>>....Unable to update "_ECXCODE_" "_$P(ECXREC,U,2)_".")

 ..D BMES^XPDUTL(">>>....Contact support for assistance")

 .S DIE="^ECX(728.441,",DA=ECXIEN,DR="1///^S X=ECXDESC"

 .D ^DIE

 .D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" updated")

 Q

 ;

LOCK ;

 N ECXI

 S ^DD(728.441,.01,7.5)="I $G(DIC(0))[""L"",'$D(ECX4CHAR) D EN^DDIOL(""Entries can only be added by CHAR4 Council."","""",""!?5"") K X"

 F ECXI=.01,1,3 I $P(^DD(728.441,ECXI,0),U,2)'["I" S $P(^DD(728.441,ECXI,0),U,2)=$P(^DD(728.441,ECXI,0),U,2)_"I" ;Makes all fields uneditable

 Q

UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated

 ;;PDIA^PILOT DIALYSIS Physician

 ;;PTEM^PILOT DIALYSIS Multidisc

 ;;RHQC^Reserved

 ;;WCQC^Women's Telehlth Pilot

 ;;XREC^PIM Demo

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECX150PT   1932     printed  Apr 09, 2024@20:54:56                                                                                                                                                                                                    Page 2

ECX150PT  ;ALB/AG-ECX*3.0*150 Post-Init RTN ; 4/7/14 12:05pm

 +1       ;;3.0;DSS EXTRACTS;**150**;;Build 3

 +2       ;

 +3       ;Post-init routine adding new entries and updating current entries to

 +4       ;NATIONAL CLINIC (#728.441) file

 +5       ;

 +6        QUIT 

 +7       ;

EN        ;routine entry point

 +1       ;unlock Data Dictionary to allow changes

           DO UNLOCK

 +2       ;change name to existing Clinic codes

           DO UPDATE

 +3        DO INACT^ECX150P1

 +4        DO INACT^ECX150P2

 +5       ;lock Data Dictionary to restrict changes

           DO LOCK

 +6        QUIT 

 +7       ;

UNLOCK    ;

 +1        KILL ^DD(728.441,.01,7.5)

 +2        NEW ECXI

 +3        FOR ECXI=.01,1,3

               SET $PIECE(^DD(728.441,ECXI,0),"^",2)=$TRANSLATE($PIECE(^DD(728.441,ECXI,0),"^",2),"I","")

 +4        QUIT 

UPDATE    ;changing short description of existing clinic

 +1        NEW ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,ECXI,ECXREC

 +2        DO BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file..")

 +3        IF $PIECE(^DD(728.441,.01,0),"^",2)["I"

               Begin DoDot:1

 +4                DO BMES^XPDUTL(">>Unable to update File 728.441, it is locked")

 +5                DO BMES^XPDUTL("Contact support for assistance")

               End DoDot:1

               QUIT 

 +6        FOR ECXI=1:1

               SET ECXREC=$PIECE($TEXT(UPDCLIN+ECXI),";;",2)

               if ECXREC="QUIT"

                   QUIT 

               Begin DoDot:1

 +7                SET ECXCODE=$PIECE(ECXREC,"^")

                   SET ECXDESC=$PIECE(ECXREC,"^",2)

 +8                SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")

 +9                IF 'ECXIEN

                       Begin DoDot:2

 +10                       DO BMES^XPDUTL(">>>....Unable to update "_ECXCODE_" "_$PIECE(ECXREC,U,2)_".")

 +11                       DO BMES^XPDUTL(">>>....Contact support for assistance")

                       End DoDot:2

                       QUIT 

 +12               SET DIE="^ECX(728.441,"

                   SET DA=ECXIEN

                   SET DR="1///^S X=ECXDESC"

 +13               DO ^DIE

 +14               DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" updated")

               End DoDot:1

 +15       QUIT 

 +16      ;

LOCK      ;

 +1        NEW ECXI

 +2        SET ^DD(728.441,.01,7.5)="I $G(DIC(0))[""L"",'$D(ECX4CHAR) D EN^DDIOL(""Entries can only be added by CHAR4 Council."","""",""!?5"") K X"

 +3       ;Makes all fields uneditable

           FOR ECXI=.01,1,3

               IF $PIECE(^DD(728.441,ECXI,0),U,2)'["I"

                   SET $PIECE(^DD(728.441,ECXI,0),U,2)=$PIECE(^DD(728.441,ECXI,0),U,2)_"I"

 +4        QUIT 

UPDCLIN   ;Contains the NATIONAL CLINIC entry description to be updated

 +1       ;;PDIA^PILOT DIALYSIS Physician

 +2       ;;PTEM^PILOT DIALYSIS Multidisc

 +3       ;;RHQC^Reserved

 +4       ;;WCQC^Women's Telehlth Pilot

 +5       ;;XREC^PIM Demo

 +6       ;;QUIT