ECX146PT ;ALB/AG-PATCH ECX*3.0*146 POST-INIT RTN ; 4/2/13 9:49am
;;3.0;DSS EXTRACTS;**146**;DEC 22, 1997;Build 1
;
;Post-init routine adding new entries and updating current entries to
;
;NATIONAL CLINIC file(#728.441)
;
;
Q
EN ;Routine entry point
D ADDNEW ;add new Clinic codes
D UPDATE ;change name to existing Clinic codes
Q
;
;
ADDNEW ;Add new entry to file 728.441
;ECXREC is in format:code^short description
;
;
N ECXFDA,ECXERR,ECXCODE,ECXREC,I
;
;-get National Clinic record
F I=1:1 S ECXREC=$P($T(ADDCLIN+I),";;",2) Q:ECXREC="QUIT" D
.;
.;-National Clinic Code
.S ECXCODE=$P(ECXREC,"^")
.;
.;-quit w/error message if entry already exists in file #728.441
.I $$FIND1^DIC(728.441,"","X",ECXCODE) D Q
..D BMES^XPDUTL(">>>..."_ECXCODE_" "_$P(ECXREC,U,2)_" not added, entry already exists.")
..D BMES^XPDUTL(">>>Delete entry and reinstall patch if entry was not created by a ")
..D BMES^XPDUTL(">>> previous installation of this patch.")
.;
.;Setup field values of new entry
.S ECXFDA(728.441,"+1,",.01)=ECXCODE
.S ECXFDA(728.441,"+1,",1)=$P(ECXREC,"^",2)
.;
.;-add new entry to file #728.441
.D UPDATE^DIE("E","ECXFDA","","ECXERR")
.;
.I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" added to file.")
.I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$P(ECXREC,U,2)_" to file.")
;
Q
UPDATE ;changing short description of existing clinic
N ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,I
D BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file...")
F I=1:1 S ECXREC=$P($T(UPDCLIN+I),";;",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 add "_ECXCODE_" "_$P(ECXREC,U,2)_" to file.")
..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")
;
ADDCLIN ;Contains the NATIONAL CLINIC entries to be added
;;AMSP^Antimicrb Stwrdshp Pharmacist
;;CSCC^CnsltSprtClinc CreatvArtsFestvl
;;CSCF^CnsltSprtClinc GolfPgm
;;CSCG^CnsltSprtClinc GldnAgGms
;;CSCL^CnsltSprtClinc WellnessPgm
;;CSCN^CnsltSprtClinc WintrSprtClinc
;;CSCS^CnsltSprtClinc SummrClinc
;;CSCT^CnsltSprtClinc TEE Trnmt
;;CSCW^CnsltSprtClinc WhlchrGms
;;ECOP^E-Cnslt Pharmacist
;;GERP^Geriatric Pharmacist
;;PIMI^Polytrauma Integ Med Init
;;SMOP^Smk Cessation Pharmacist
;;SPAP^SpcltyCare Anticoag Pharmacist
;;VITL^VITAL Initiative
;;ABCD^Locally Defined A
;;BCDE^Locally Defined B
;;CDEF^Locally Defined C
;;DEFG^Locally Defined D
;;EFGH^Locally Defined E
;;FGHI^Locally Defined F
;;GHIJ^Locally Defined G
;;HIJK^Locally Defined H
;;IJKL^Locally Defined I
;;JKLM^Locally Defined J
;;KLMN^Locally Defined K
;;LMNO^Locally Defined L
;;MNOP^Locally Defined M
;;NOPQ^Locally Defined N
;;OPQR^Locally Defined O
;;PQRS^Locally Defined P
;;QRST^Locally Defined Q
;;RSTU^Locally Defined R
;;STUV^Locally Defined S
;;TUVW^Locally Defined T
;;UVWX^Locally Defined U
;;VWXY^Locally Defined V
;;WXYZ^Locally Defined W
;;XYZA^Locally Defined X
;;YZAB^Locally Defined Y
;;ZABC^Locally Defined Z
;;QUIT
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
;;CGPH^CntrlzAnticoagMgmt Pharmacist
;;CPRY^SCAN Mini-Spec Clinic
;;PACP^PACT Anticoag Tm Pharmacist
;;WCNC^VITAL Initiative (temp)
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX146PT 3566 printed Dec 13, 2024@01:49:39 Page 2
ECX146PT ;ALB/AG-PATCH ECX*3.0*146 POST-INIT RTN ; 4/2/13 9:49am
+1 ;;3.0;DSS EXTRACTS;**146**;DEC 22, 1997;Build 1
+2 ;
+3 ;Post-init routine adding new entries and updating current entries to
+4 ;
+5 ;NATIONAL CLINIC file(#728.441)
+6 ;
+7 ;
+8 QUIT
EN ;Routine entry point
+1 ;add new Clinic codes
DO ADDNEW
+2 ;change name to existing Clinic codes
DO UPDATE
+3 QUIT
+4 ;
+5 ;
ADDNEW ;Add new entry to file 728.441
+1 ;ECXREC is in format:code^short description
+2 ;
+3 ;
+4 NEW ECXFDA,ECXERR,ECXCODE,ECXREC,I
+5 ;
+6 ;-get National Clinic record
+7 FOR I=1:1
SET ECXREC=$PIECE($TEXT(ADDCLIN+I),";;",2)
if ECXREC="QUIT"
QUIT
Begin DoDot:1
+8 ;
+9 ;-National Clinic Code
+10 SET ECXCODE=$PIECE(ECXREC,"^")
+11 ;
+12 ;-quit w/error message if entry already exists in file #728.441
+13 IF $$FIND1^DIC(728.441,"","X",ECXCODE)
Begin DoDot:2
+14 DO BMES^XPDUTL(">>>..."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" not added, entry already exists.")
+15 DO BMES^XPDUTL(">>>Delete entry and reinstall patch if entry was not created by a ")
+16 DO BMES^XPDUTL(">>> previous installation of this patch.")
End DoDot:2
QUIT
+17 ;
+18 ;Setup field values of new entry
+19 SET ECXFDA(728.441,"+1,",.01)=ECXCODE
+20 SET ECXFDA(728.441,"+1,",1)=$PIECE(ECXREC,"^",2)
+21 ;
+22 ;-add new entry to file #728.441
+23 DO UPDATE^DIE("E","ECXFDA","","ECXERR")
+24 ;
+25 IF '$DATA(ECXERR)
DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" added to file.")
+26 IF $DATA(ECXERR)
DO BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$PIECE(ECXREC,U,2)_" to file.")
End DoDot:1
+27 ;
+28 QUIT
UPDATE ;changing short description of existing clinic
+1 NEW ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,I
+2 DO BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file...")
+3 FOR I=1:1
SET ECXREC=$PIECE($TEXT(UPDCLIN+I),";;",2)
if ECXREC="QUIT"
QUIT
Begin DoDot:1
+4 SET ECXCODE=$PIECE(ECXREC,"^")
SET ECXDESC=$PIECE(ECXREC,"^",2)
+5 SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
+6 IF ECXIEN=""
Begin DoDot:2
+7 DO BMES^XPDUTL(">>>...Unable to add "_ECXCODE_" "_$PIECE(ECXREC,U,2)_" to file.")
+8 DO BMES^XPDUTL("Contact support for assistance")
End DoDot:2
QUIT
+9 SET DIE="^ECX(728.441,"
SET DA=ECXIEN
SET DR="1///^S X=ECXDESC"
+10 DO ^DIE
+11 DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" updated")
End DoDot:1
+12 ;
ADDCLIN ;Contains the NATIONAL CLINIC entries to be added
+1 ;;AMSP^Antimicrb Stwrdshp Pharmacist
+2 ;;CSCC^CnsltSprtClinc CreatvArtsFestvl
+3 ;;CSCF^CnsltSprtClinc GolfPgm
+4 ;;CSCG^CnsltSprtClinc GldnAgGms
+5 ;;CSCL^CnsltSprtClinc WellnessPgm
+6 ;;CSCN^CnsltSprtClinc WintrSprtClinc
+7 ;;CSCS^CnsltSprtClinc SummrClinc
+8 ;;CSCT^CnsltSprtClinc TEE Trnmt
+9 ;;CSCW^CnsltSprtClinc WhlchrGms
+10 ;;ECOP^E-Cnslt Pharmacist
+11 ;;GERP^Geriatric Pharmacist
+12 ;;PIMI^Polytrauma Integ Med Init
+13 ;;SMOP^Smk Cessation Pharmacist
+14 ;;SPAP^SpcltyCare Anticoag Pharmacist
+15 ;;VITL^VITAL Initiative
+16 ;;ABCD^Locally Defined A
+17 ;;BCDE^Locally Defined B
+18 ;;CDEF^Locally Defined C
+19 ;;DEFG^Locally Defined D
+20 ;;EFGH^Locally Defined E
+21 ;;FGHI^Locally Defined F
+22 ;;GHIJ^Locally Defined G
+23 ;;HIJK^Locally Defined H
+24 ;;IJKL^Locally Defined I
+25 ;;JKLM^Locally Defined J
+26 ;;KLMN^Locally Defined K
+27 ;;LMNO^Locally Defined L
+28 ;;MNOP^Locally Defined M
+29 ;;NOPQ^Locally Defined N
+30 ;;OPQR^Locally Defined O
+31 ;;PQRS^Locally Defined P
+32 ;;QRST^Locally Defined Q
+33 ;;RSTU^Locally Defined R
+34 ;;STUV^Locally Defined S
+35 ;;TUVW^Locally Defined T
+36 ;;UVWX^Locally Defined U
+37 ;;VWXY^Locally Defined V
+38 ;;WXYZ^Locally Defined W
+39 ;;XYZA^Locally Defined X
+40 ;;YZAB^Locally Defined Y
+41 ;;ZABC^Locally Defined Z
+42 ;;QUIT
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
+1 ;;CGPH^CntrlzAnticoagMgmt Pharmacist
+2 ;;CPRY^SCAN Mini-Spec Clinic
+3 ;;PACP^PACT Anticoag Tm Pharmacist
+4 ;;WCNC^VITAL Initiative (temp)
+5 ;;QUIT
