IBYSB1.m

IBYSB1 ;ALB/ARH - IB*2.0*124 POST INIT: UPDATE FORM CODES ; 2/9/00

 ;;2.0;INTEGRATED BILLING;**124**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ;

 Q

POST ;

 N IBA

 S IBA(1)="",IBA(2)="    IB*2.0*124 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

 ;

 D MUCODES^IBYSB2 ; form codes to MCCR Utility file (#399.1)

 D ADDPOS ;         add Place of Service Codes  (353.1)

 ;

 S IBA(1)="",IBA(2)="    IB*2.0*124 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

 ;

 Q

 ;

ADDPOS ; Add Place of Service Codes (353.1)

 N IBA,IBCNT,IBI,IBLN,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y S IBCNT=0

 ;

 F IBI=1:1 S IBLN=$P($T(POSF+IBI),";;",2) Q:IBLN=""  I $E(IBLN)'=" " D

 . ;

 . I $O(^IBE(353.1,"B",$P(IBLN,U,1),0)) Q

 . ;

 . K DD,DO S DLAYGO=353.1,DIC="^IBE(353.1,",DIC(0)="L",X=$P(IBLN,U,1) D FILE^DICN K DIC I Y<1 K X,Y Q

 . S IBFN=+Y,IBCNT=IBCNT+1

 . ;

 . S DR=".02///"_$P(IBLN,U,2)_";.03///"_$P(IBLN,U,3)

 . S DIE="^IBE(353.1,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y

 ;

POSQ S IBA(1)="      * "_$J(IBCNT,3)_"  HCFA 1500 Place of Service Codes added (353.1)"

 D MES^XPDUTL(.IBA)

 Q

 ;

POSF ;  Place of Service (353.1)

 ;; code ^ name ^ abbreviation

 ;;    

 ;;50^FEDERALLY QUALIFIED HEALTH CENTER^FED QUAL HLTH CTR

 ;;60^MASS IMMUNIZATION CENTER^MASS IMMUNIZATON CTR

 ;;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBYSB1   1343     printed  Apr 09, 2024@21:30:13                                                                                                                                                                                                      Page 2

IBYSB1    ;ALB/ARH - IB*2.0*124 POST INIT: UPDATE FORM CODES ; 2/9/00

 +1       ;;2.0;INTEGRATED BILLING;**124**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;

 +5        QUIT 

POST      ;

 +1        NEW IBA

 +2        SET IBA(1)=""

           SET IBA(2)="    IB*2.0*124 Post-Install ....."

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +3       ;

 +4       ; form codes to MCCR Utility file (#399.1)

           DO MUCODES^IBYSB2

 +5       ;         add Place of Service Codes  (353.1)

           DO ADDPOS

 +6       ;

 +7        SET IBA(1)=""

           SET IBA(2)="    IB*2.0*124 Post-Install Complete"

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +8       ;

 +9        QUIT 

 +10      ;

ADDPOS    ; Add Place of Service Codes (353.1)

 +1        NEW IBA,IBCNT,IBI,IBLN,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y

           SET IBCNT=0

 +2       ;

 +3        FOR IBI=1:1

               SET IBLN=$PIECE($TEXT(POSF+IBI),";;",2)

               if IBLN=""

                   QUIT 

               IF $EXTRACT(IBLN)'=" "

                   Begin DoDot:1

 +4       ;

 +5                    IF $ORDER(^IBE(353.1,"B",$PIECE(IBLN,U,1),0))

                           QUIT 

 +6       ;

 +7                    KILL DD,DO

                       SET DLAYGO=353.1

                       SET DIC="^IBE(353.1,"

                       SET DIC(0)="L"

                       SET X=$PIECE(IBLN,U,1)

                       DO FILE^DICN

                       KILL DIC

                       IF Y<1

                           KILL X,Y

                           QUIT 

 +8                    SET IBFN=+Y

                       SET IBCNT=IBCNT+1

 +9       ;

 +10                   SET DR=".02///"_$PIECE(IBLN,U,2)_";.03///"_$PIECE(IBLN,U,3)

 +11                   SET DIE="^IBE(353.1,"

                       SET DA=+IBFN

                       DO ^DIE

                       KILL DIE,DA,DR,X,Y

                   End DoDot:1

 +12      ;

POSQ       SET IBA(1)="      * "_$JUSTIFY(IBCNT,3)_"  HCFA 1500 Place of Service Codes added (353.1)"

 +1        DO MES^XPDUTL(.IBA)

 +2        QUIT 

 +3       ;

POSF      ;  Place of Service (353.1)

 +1       ;; code ^ name ^ abbreviation

 +2       ;;    

 +3       ;;50^FEDERALLY QUALIFIED HEALTH CENTER^FED QUAL HLTH CTR

 +4       ;;60^MASS IMMUNIZATION CENTER^MASS IMMUNIZATON CTR

 +5       ;;