IBCE837S.m

IBCE837S ;EDE/JWS - RPC to change 837 FHIR Transmit Yes/No in IB SITE PARAMETERS;10/14/2018

 ;;2.0;INTEGRATED BILLING;**650**;21-MAR-94;Build 21

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

 ;

PUT(RESULT,ARG) ;

 ;

 N IB837,RES,DILOCKTM,DISYS,DT,DTIME,IO,X

 K RESULT

 ;JWS;IB*2.0*650v9;remove setting of DUZ(0)

 D DTNOLF^DICRW

 S RES("site")=$P($$SITE^VASITE,U,3)

 ; 837ENABLE = 0 for NO or disble

 ;             1 for YES or enable

 S IB837=$G(ARG("837ENABLE"))

 I $$GET1^DIQ(350.9,"1,",8.21,"I")=IB837 S RES("status")="Unchanged from "_$S(IB837=1:"YES",1:"NO") G RET

 L +^IBE(350.9):5 I $T S DIE="^IBE(350.9,",DA=1,DR="8.21////"_IB837 D ^DIE

 L -^IBE(350.9)

 I $$GET1^DIQ(350.9,"1,",8.21,"I")=IB837 S RES("status")="Changed to "_$S(IB837=1:"YES",1:"NO") G RET

 S RES("status")="Unchanged from "_$$GET1^DIQ(350.9,"1,",8.21)

 ;

RET ; setup return JSON

 ; create JSON structured message

 D ENCODE^XLFJSONE("RES","RESULT")

 D FINISH^IBCE837I

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCE837S   989     printed  Nov 22, 2024@17:19:40                                                                                                                                                                                                     Page 2

IBCE837S  ;EDE/JWS - RPC to change 837 FHIR Transmit Yes/No in IB SITE PARAMETERS;10/14/2018

 +1       ;;2.0;INTEGRATED BILLING;**650**;21-MAR-94;Build 21

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

 +3       ;

PUT(RESULT,ARG) ;

 +1       ;

 +2        NEW IB837,RES,DILOCKTM,DISYS,DT,DTIME,IO,X

 +3        KILL RESULT

 +4       ;JWS;IB*2.0*650v9;remove setting of DUZ(0)

 +5        DO DTNOLF^DICRW

 +6        SET RES("site")=$PIECE($$SITE^VASITE,U,3)

 +7       ; 837ENABLE = 0 for NO or disble

 +8       ;             1 for YES or enable

 +9        SET IB837=$GET(ARG("837ENABLE"))

 +10       IF $$GET1^DIQ(350.9,"1,",8.21,"I")=IB837

               SET RES("status")="Unchanged from "_$SELECT(IB837=1:"YES",1:"NO")

               GOTO RET

 +11       LOCK +^IBE(350.9):5

           IF $TEST

               SET DIE="^IBE(350.9,"

               SET DA=1

               SET DR="8.21////"_IB837

               DO ^DIE

 +12       LOCK -^IBE(350.9)

 +13       IF $$GET1^DIQ(350.9,"1,",8.21,"I")=IB837

               SET RES("status")="Changed to "_$SELECT(IB837=1:"YES",1:"NO")

               GOTO RET

 +14       SET RES("status")="Unchanged from "_$$GET1^DIQ(350.9,"1,",8.21)

 +15      ;

RET       ; setup return JSON

 +1       ; create JSON structured message

 +2        DO ENCODE^XLFJSONE("RES","RESULT")

 +3        DO FINISH^IBCE837I

 +4        QUIT 

 +5       ;