SOWKP51.m

SOWKP51 ;B'HAM ISC/DB - Routine to add CDC Accounts

 ;;3.0; Social Work ;**51**;27 Apr 93

 D Q

 I $D(^SOWK(651,"B","PTSD CWT/TR")) W !!,"It appears that this patch has been previously installed. The post-",!,"installation routine will not repeat the update process.",! G Q

 W !!,"This patch will enter the following CDC codes into your Cost Distribution",!,"Center file.:",!

 W !,"COST CENTER NAME",?50,"CDC Distribution Account",! F X=1:1:74 W "="

 F XX=0:1:6 W !,$P($T(TXT+XX),";",3),?55,$P($T(TXT+XX),";",4)

ASKOK ; W !!,"OK to continue " S %=1,DIR(0)="Y" D YN^DICN I %'=1 W !!,"No updating has occurred.." G Q

 ;

 ;Add entries

 F PTCHADD=0:1:6 S DIC="^SOWK(651,",DIC(0)="L",X=$P($T(TXT+PTCHADD),";",3) D ^DIC S PTCHEDT(PTCHADD)=+Y

 ;

 ;Now edit the new additions

 S EDTIEN=""

LP ;Loop through additions

 F EDTIEN=0:1:6 S DA=PTCHEDT(EDTIEN),CDC=$P($T(TXT+EDTIEN),";",4),DIE="^SOWK(651,",DR="1///0;3///^S X=CDC;4///0;6///1" W !,$P(^SOWK(651,DA,0),"^",1),?45,CDC D ^DIE,STUFF W " ...added"

 ;

 W !,"File update completed.",!

Q K DA,DIE,DIC,DR,XX,PTCHADD,PTCHEDT Q

STUFF S DR="2///^S X="_$S(EDTIEN<2:7,1:8)_";5///^S X="_$S(EDTIEN<2:"""I""",1:"""O""")

 S DIE="^SOWK(651,",DA=PTCHEDT(EDTIEN) D ^DIE

 Q

 ;

TXT ;;PTSD CWT/TR;1716.00

 ;;GENERAL CWT/TR;1717.00

 ;;HCHV/HMI;2312.00

 ;;PSYCHOSOCIAL REHABILITATION - GROUP;2314.00

 ;;PSYCHOSOCIAL REHABILITATION - INDIVIDUAL;2315.00

 ;;HUD/VASH;2318.00

 ;;COMMUNITY OUTREACH TO HOMELESS VETERANS;2319.00

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SOWKP51   1475     printed  Apr 09, 2024@21:40:18                                                                                                                                                                                                     Page 2

SOWKP51   ;B'HAM ISC/DB - Routine to add CDC Accounts

 +1       ;;3.0; Social Work ;**51**;27 Apr 93

 +2        DO Q

 +3        IF $DATA(^SOWK(651,"B","PTSD CWT/TR"))

               WRITE !!,"It appears that this patch has been previously installed. The post-",!,"installation routine will not repeat the update process.",!

               GOTO Q

 +4        WRITE !!,"This patch will enter the following CDC codes into your Cost Distribution",!,"Center file.:",!

 +5        WRITE !,"COST CENTER NAME",?50,"CDC Distribution Account",!

           FOR X=1:1:74

               WRITE "="

 +6        FOR XX=0:1:6

               WRITE !,$PIECE($TEXT(TXT+XX),";",3),?55,$PIECE($TEXT(TXT+XX),";",4)

ASKOK     ; W !!,"OK to continue " S %=1,DIR(0)="Y" D YN^DICN I %'=1 W !!,"No updating has occurred.." G Q

 +1       ;

 +2       ;Add entries

 +3        FOR PTCHADD=0:1:6

               SET DIC="^SOWK(651,"

               SET DIC(0)="L"

               SET X=$PIECE($TEXT(TXT+PTCHADD),";",3)

               DO ^DIC

               SET PTCHEDT(PTCHADD)=+Y

 +4       ;

 +5       ;Now edit the new additions

 +6        SET EDTIEN=""

LP        ;Loop through additions

 +1        FOR EDTIEN=0:1:6

               SET DA=PTCHEDT(EDTIEN)

               SET CDC=$PIECE($TEXT(TXT+EDTIEN),";",4)

               SET DIE="^SOWK(651,"

               SET DR="1///0;3///^S X=CDC;4///0;6///1"

               WRITE !,$PIECE(^SOWK(651,DA,0),"^",1),?45,CDC

               DO ^DIE

               DO STUFF

               WRITE " ...added"

 +2       ;

 +3        WRITE !,"File update completed.",!

Q          KILL DA,DIE,DIC,DR,XX,PTCHADD,PTCHEDT

           QUIT 

STUFF      SET DR="2///^S X="_$SELECT(EDTIEN<2:7,1:8)_";5///^S X="_$SELECT(EDTIEN<2:"""I""",1:"""O""")

 +1        SET DIE="^SOWK(651,"

           SET DA=PTCHEDT(EDTIEN)

           DO ^DIE

 +2        QUIT 

 +3       ;

TXT       ;;PTSD CWT/TR;1716.00

 +1       ;;GENERAL CWT/TR;1717.00

 +2       ;;HCHV/HMI;2312.00

 +3       ;;PSYCHOSOCIAL REHABILITATION - GROUP;2314.00

 +4       ;;PSYCHOSOCIAL REHABILITATION - INDIVIDUAL;2315.00

 +5       ;;HUD/VASH;2318.00

 +6       ;;COMMUNITY OUTREACH TO HOMELESS VETERANS;2319.00