IBTRH5C.m

IBTRH5C ;ALB/FA - HCSR Create 278 Request ;12-AUG-2014

 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240

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

 ;;

 ; Contains Entry points and functions used in creating a 278 request from a

 ; selected entry in the HCSR Response worklist

 ;

 ; --------------------------   Entry Points   --------------------------------

 ; AMBTI        - Called from within the input template to see if any of the 

 ;                Ambulance Transport Information fields have a value

 ;                Fields: 18.01, 18.02, 18.03, 18.04, 18.05, 18.06, 18.09, 18.1 

 ; ATTPHY       - Returns the Attending Physician of the entry

 ; CERTCD       - Dictionary Screen function for Certification Type Code (2.02)

 ; CONTPH       - Input Validation method for fields 20, 21, 22

 ; CRTENTRY     - Creates a new worklist entry from a specified worklist entry.

 ;                Copies all the request data from the specified entry into the

 ;                new entry

 ; OXYET        - Called from within the input template to determine if one of

 ;                Oxygen Equipment Type fields = 'D' or 'E'. Fields 8.01, 8.02

 ;                8.03

 ; REQCAT       - Dictionary Screen function for Request Category Field 2.01

 ;                and field 356.2216/.15

 ; SLDXDUP      - Dictionary Screen function for Service Line Diagnosis fields

 ;                Checks to insure the diagnosis is NOT a duplicate entry AND 

 ;                points to a valid diagnosis multiple.

 ;                Fields: 2216,2.01, 2216,2.02, 2216,2.03, 2216,2.04 

 ; TOOTHSP      - Called from within the Input Template to check if subsequent

 ;                Tooth Surfaces have values

 ;-----------------------------------------------------------------------------

 ;

CONTPH(FIELD)   ;EP

 ; Input validation method for Requester Contact Numbers 1,2 and 3 (fields 20,

 ; 21 and 22)

 ; Input:   FIELD   - Requester Contact Number field being validated

 ;          DA      - IEN of the 356.22 entry being edited

 ;          X       - Internal Value of the user response

 ; Output:  None

 ; Returns: 1 - Answer is valid, 0 - Otherwise

 N RETURN,TYPE,XX

 S XX=$S(FIELD=20:19.01,FIELD=21:19.02,FIELD=22:19.03,1:0)

 Q:XX=0 0                                       ; Invalid FIELD

 S RETURN=1                                     ; Assume valid

 S TYPE=$$GET1^DIQ(356.22,DA_",",XX,"I")        ; Requester Contact Qualifier

 S TYPE=$$GET1^DIQ(365.021,TYPE_",",.01)        ; Requester Contact Qualifier Code

 ;

 I (TYPE="ED")!(TYPE="EM")!(TYPE="UR")!(TYPE="EX") D  Q RETURN

 . S RETURN=$S($L(X)'>250:1,1:0)

 S XX=$TR(X,"-","")                             ; Remove dashes

 I XX'?10N S RETURN=0

 Q RETURN

 ;

CRTENTRY(IBTRIEN,RIEN,IEN312,REQBY,DELCCDE,DELAY,NOOUTPUT,TTYPE)   ;EP

 ; Creates a new entry in 356.22 by copying fields from an existing entry. Used

 ; to create a request from a Response by copying the request entry pointed to

 ; from the response entry

 ; Input:   IBTRIEN - IEN of the entry to be copied

 ;          RIEN    - IEN of the response entry

 ;          IEN312  - IEN of the insurance multiple to set into field .03

 ;                    Optional, if not passed, this field is copied from the

 ;                    existing entry

 ;          REQBY   - DUZ of the Requested By user to set into field .11

 ;                    Optional, if not passed, this field is copied from the

 ;                    existing entry

 ;          DELCCDE - 1 to clear the value for Certification Type (field 2.02)

 ;                    Optional, if not passed, defaults to 0

 ;          DELAY   - 'D' or a future date to set a next review date and status

 ;                    to '08'

 ;                    Optional, if not passed, defaults to ""

 ;          NOOUTPUT - suppress error message output, if not passed, defaults to 0 (false)

 ;          TTYPE   - UM02 value for 278x215 if cancel

 ;

 ; Output:  New entry created in 356.22

 ; Returns: 0 - Copy was NOT successful and error messages were displayed

 ;          Otherwise, IEN of the new entry in 356.22 is returned

 N ERROR,FLDS,IENARRY,IENS,NEWENTRY,NIENS,NIENS16,OLDENTRY,STOPFLG,XX,Z,Z1,XX1

 S:'$D(NOOUTPUT) NOOUTPUT=0

 S:'$D(IEN312) IEN312=""

 S:'$D(REQBY) REQBY=""

 S:'$D(DELCCDE) DELCCDE=0

 S:'$D(DELAY) DELAY=""

 S IENS=IBTRIEN_","

 S FLDS=".02;.03:.07;.11;.16;2.01:2.25;3*;4.01:4.14;5.01:5.18;6.01:6.18"

 S FLDS=FLDS_";7.01:7.13;8.01:8.08;9.01:9.08;10.01:10.13;11*;12;14*;15*;18.01:18.1;19.01:19.03;20:22"

 D GETS^DIQ(356.22,IENS,FLDS,"NI","OLDENTRY","ERROR")

 I $D(ERROR) D COPYERR(0,.ERROR) Q 0            ; Unsuccessful read of initial entry

 ;

 ; Copy internal data from the specified entry to a new array

 M NEWENTRY(356.22,"+1,")=OLDENTRY(356.22,IENS)

 D COPYINT(.NEWENTRY)

 ;

 ; Set the Event Date to 'NOW'

 S NEWENTRY(356.22,"+1,",.01)=$$NOW^XLFDT()

 S:IEN312'="" NEWENTRY(356.22,"+1,",.03)=IEN312  ; Set Insurance Multiple IEN

 S NEWENTRY(356.22,"+1,",.08)=$S(DELAY'="":"08",1:0) ; Initialize status to 0

 S:REQBY'="" NEWENTRY(356.22,"+1,",.11)=REQBY

 I DELCCDE D

 . S NEWENTRY(356.22,"+1,",2.02)=""  ; Clear Certification Type field

 . S NEWENTRY(356.22,"+1,",.18)=1    ; Flag creation from Response

 I $G(TTYPE)="C" S NEWENTRY(356.22,"+1,",2.02)=3

 S:DELAY'="" NEWENTRY(356.22,"+1,",.17)=DELAY   ; Delayed until DELAY

 S XX=$$GET1^DIQ(356.22,RIEN_",",103.02) ; Auth. or Ref. number from response

 S XX1=$$GET1^DIQ(356.22,RIEN_",",103.01) ; CERT ACT CODE

 I $F(",A1,A2,A6,",","_XX1_",") S NEWENTRY(356.22,"+1,",17.01)=XX

 I $F(",A3,A4,C,CT,NA,",","_XX1_",") D

 . I XX="" S XX=$$GET1^DIQ(356.22,RIEN_",",17.02)

 . S NEWENTRY(356.22,"+1,",17.02)=XX

 K IENARRY

 D UPDATE^DIE(,"NEWENTRY","IENARRY","ERROR")    ; File the initial data

 I $D(ERROR) D COPYERR(1,.ERROR) Q 0            ; Unsuccessful copy of initial data

 ; update field .27 of response message

 I DELCCDE D  I $D(ERROR) D COPYERR(1,.ERROR) Q 0

 . N UPDRSP

 . S UPDRSP(356.22,RIEN_",",.27)=1

 . D FILE^DIE("I","UPDRSP","ERROR")

 . Q

 ;

 ; Next copy multiples IENs of the new entry in 356.22 (top level)

 S NIENS=IENARRY(1)_","

 ;

 ; File Diagnosis multiples (356.223)

 I '$$MLTCPY(356.223,NIENS) Q 0

 ;

 ; File Attachment multiples (356.2211)

 I '$$MLTCPY(356.2211,NIENS) Q 0

 ;

 ; File Patient Event Transport multiples (356.2214)

 I '$$MLTCPY(356.2214,NIENS) Q 0

 ;

 ; File Other UMO multiples (356.2215)

 I '$$MLTCPY(356.2215,NIENS) Q 0

 ;

 ; File Provider multiples (356.2213)

 ; NOTE: not all fields are being copied, each entry needs to be handled separately

 S Z=0,STOPFLG=0

 F  D  Q:'Z!STOPFLG

 . S Z=$O(^IBT(356.22,IBTRIEN,13,Z))

 . Q:'Z

 . S IENS=Z_","_IBTRIEN_","

 . K NEWENTRY,OLDENTRY

 . D GETS^DIQ(356.2213,IENS,".01:.03","NI","OLDENTRY","ERROR")

 . I $D(ERROR) D COPYERR(0,.ERROR) S STOPFLG=1 Q

 . M NEWENTRY(356.2213,"+1,"_NIENS)=OLDENTRY(356.2213,IENS)

 . D COPYINT(.NEWENTRY)

 . D UPDATE^DIE(,"NEWENTRY",,"ERROR")

 . I $D(ERROR) D COPYERR(1,.ERROR) S STOPFLG=1

 Q:STOPFLG 0

 ;

 ; File Service Line multiples (356.2216)

 ; NOTE: not all fields are being copied, each entry needs to be handled separately

 S Z=0,STOPFLG=0

 F  D  Q:'Z!STOPFLG

 . S Z=$O(^IBT(356.22,IBTRIEN,16,Z))

 . Q:'Z

 . S IENS=Z_","_IBTRIEN_","

 . K OLDENTRY

 . S FLDS=".01:.14;1.01:1.12;2.01:2.09;3.01:3.07;4*;5.01:5.08;6*;7"

 . D GETS^DIQ(356.2216,IENS,FLDS,"NI","OLDENTRY","ERROR")

 . I $D(ERROR) D COPYERR(0,.ERROR) S STOPFLG=1 Q

 . K NEWENTRY

 . M NEWENTRY(356.2216,"+1,"_NIENS)=OLDENTRY(356.2216,IENS)

 . D COPYINT(.NEWENTRY)

 . K IENARRY

 . D UPDATE^DIE(,"NEWENTRY","IENARRY","ERROR")

 . I $D(ERROR) D COPYERR(1,.ERROR) S STOPFLG=1

 . S NIENS16=IENARRY(1)_","_NIENS               ; IENs of the new Service Line in 356.2216

 . ;

 . ; File Service Line Tooth Information multiples (356.22164)

 . I '$$MLTCPY(356.22164,NIENS16) S STOPFLG=1 Q

 . ;

 . ; File Service Line Attachment multiple (356.22166)

 . I '$$MLTCPY(356.22166,NIENS16) S STOPFLG=1 Q

 . ;

 . ; File Service Line Provider Data multiples (356.22168)

 . ; NOTE - not all fields are being copied, each entry needs to be handled separately

 . S Z1=0

 . F  D  Q:'Z1!STOPFLG

 . . S Z1=$O(^IBT(356.22,IBTRIEN,16,Z,8,Z1))

 . . Q:'Z1

 . . S IENS=Z1_","_Z_","_IBTRIEN_","

 . . K NEWENTRY,OLDENTRY

 . . D GETS^DIQ(356.22168,IENS,".01:.03","NI","OLDENTRY","ERROR")

 . . I $D(ERROR) D COPYERR(0,.ERROR) S STOPFLG=1 Q

 . . M NEWENTRY(356.22168,"+1,"_NIENS16)=OLDENTRY(356.22168,IENS)

 . . D COPYINT(.NEWENTRY)

 . . D UPDATE^DIE(,"NEWENTRY",,"ERROR")

 . . I $D(ERROR) D COPYERR(1,.ERROR) S STOPFLG=1

 I STOPFLG Q 0

 Q $P(NIENS,",",1)

 ;

COPYERR(TYPE,ERROR) ; Displays any errors encountered while copying a request

 ; Input:   TYPE    - 0 - Error while reading data

 ;                  - 1 - Error while filing data

 ;          ERROR   - Array used for FM error reporting

 ; Output:  Error(s) are displayed

 I '$G(NOOUTPUT) Q  ;IF NOT TO DISPLAY OUTPUT, for background job

 N STR,Z,Z1

 Q:'$D(ERROR)

 W !,"Unable to copy - the following error was encountered while "

 W $S(TYPE:"filing",1:"retrieving")," the data:"

 S Z=0

 F  D  Q:'Z

 . S Z=$O(ERROR("DIERR",Z))

 . Q:'Z

 . S STR=$G(ERROR("DIERR",Z))

 . W:STR'="" !,"Error code: "_STR

 . S STR=$G(ERROR("DIERR",Z,"PARAM","FILE"))

 . W:STR'="" !,"File number: "_STR

 . S STR=$G(ERROR("DIERR",Z,"PARAM","FIELD"))

 . W:STR'="" !,"Field number: "_STR

 . W !,"Error text:"

 . S Z1=0

 . F  D  Q:'Z1

 . . S Z1=$O(ERROR("DIERR",1,"TEXT",Z1))

 . . Q:'Z1

 . . W !,ERROR("DIERR",1,"TEXT",Z1)

 Q

 ;

MLTCPY(SFNUM,NEWIENS) ; Copies the specified multiple 

 ; Input:   SFNUM       - Sub-file number of the multiple to copy

 ;          NIENS       - IENs of the new entry (copied to)

 ;          OLDENTRY    - FDA array to get data from (defined in the calling tag)

 ; Returns: 1 on successful copy, 0 on failure

 ;

 N ERROR,NEWENTRY,RES,STOPFLG,Z

 S RES=1,STOPFLG=0

 S Z=0

 F  D  Q:'Z!STOPFLG

 . S Z=$O(OLDENTRY(SFNUM,Z))

 . Q:'Z

 . K NEWENTRY

 . M NEWENTRY(SFNUM,"+1,"_NEWIENS)=OLDENTRY(SFNUM,Z)

 . D COPYINT(.NEWENTRY)

 . D UPDATE^DIE(,"NEWENTRY",,"ERROR")

 . I $D(ERROR) D COPYERR(1) S STOPFLG=1,RES=0

 Q RES

 ;

COPYINT(NEW) ; Copies an array of internal values to a new array

 ; Input:   NEW     - Current Array of internal values

 ;                    Retrieved using D GETS^DIQ(356.22,IENS,FLDS,"NI","OLD","ERROR")

 ;                    e.g. NEW(356.223,"+1,19,",.02,"I")=7209320

 ; Output:  NEW     - Updated array of internal values, stripping off the "I" subscript

 ;                    e.g. NEW(356.223,"+1,19,",.02)=7209320

 N ARRAY,NEW2,YY

 S ARRAY="NEW("""")"

 F  D  Q:ARRAY=""

 . S ARRAY=$Q(@ARRAY)

 . Q:ARRAY=""

 . I ARRAY[",""I"")" D  Q

 . . S YY=$P(ARRAY,",""I"")",1)_")"

 . . S YY="NEW2("_$P(YY,"(",2)

 . . S @YY=@ARRAY

 . S YY="NEW2("_$P(ARRAY,"(",2)

 . S @YY=@ARRAY

 K NEW

 M NEW=NEW2

 Q

 ;

OXYET(IBTRIEN)  ;EP

 ; Called from within the input template

 ; Checks to see if any of the currently filed Oxygen Equipment

 ; Types have a value of 'D' or 'E'

 ; Input:   IBTRIEN - IEN of the Patient Event

 ; Returns: 1 - at least one of the Oxygen Equipment Types is 'D' or 'E'

 ;          0 Otherwise

 N NDE

 S NDE=$G(^IBT(356.22,IBTRIEN,8))

 I ($P(NDE,"^",1)=4)!($P(NDE,"^",1)=5) Q 1

 I ($P(NDE,"^",2)=4)!($P(NDE,"^",2)=5) Q 1

 I ($P(NDE,"^",3)=4)!($P(NDE,"^",3)=5) Q 1

 Q 0

 ;

ATTPHY(IBTRIEN) ;EP

 ; Returns the Attending Physician for the admission of the

 ; specified Inpatient event

 ; Input:   IBTRIEN - IEN of the Inpatient Event

 ; Returns: IEN in file 200 of the Attending Physician or ""

 N ADATE,DA,DFN,DT,EVENT,FOUND,IADATE

 S EVENT=$G(^IBT(356.22,IBTRIEN,0))

 S DFN=$P(EVENT,"^",2)                          ; DFN of the patient

 S ADATE=$P($P(EVENT,"^",7),"-",1)              ; Internal Admit date

 S IADATE=9999999.9999999-ADATE

 S DA=$O(^DGPM("ATID1",DFN,IADATE,""))          ; DBIA419

 Q:DA="" ""                                     ; No Patient Movement admission record

 Q $$GET1^DIQ(405,DA_",",.19,"I")

 ;

REQCAT(FIELD)    ;EP

 ; Dictionary Screen for Request Category (2.01) 

 ; Checks the Request Category (2.01 OR 356.2216/.15) to make sure the answer

 ; is valid for the event type 

 ; Input:   FIELD   - Only passed when called from 356.2216/.15

 ;          DA      - IEN of the 356.22 entry being edited

 ;          Y       - Internal Value of the user response

 ; Output:  None

 ; Returns: 1 - Answer is valid, 0 - Otherwise

 N RETURN,STAT

 I $D(FIELD) D  Q RETURN

 . S RETURN=1

 . I Y'=2,Y'=4 S RETURN=0

 ;

 S STAT=$P($G(^IBT(356.22,DA,0)),"^",4)

 I STAT="I",Y'=1 Q 0

 I STAT="O",Y=1 Q 0

 Q 1

 ;

CERTCD()    ;EP

 ; Dictionary screen for field Certification Type Code 2.02

 ; Checks the code to make sure the answer is valid for the event type 

 ; Input:   DA      - IEN of the 356.22 entry being edited

 ;          Y       - Internal Value of the user response

 ; Output:  None

 ; Returns: 1 - Answer is valid, 0 - Otherwise

 N FREP

 I '$F(",3,5,",","_Y_",") Q 0

 S FREP=$P($G(^IBT(356.22,DA,0)),"^",18)

 I FREP=1,Y=5 Q 0

 Q 1

 ;

AMBTI(IBTRIEN) ;EP

 ; Called from Input Template IB CREATE 278 REQUEST to check if any of the

 ; Ambulance Transport Information fields has a value. Used to potentially

 ; skip to potentially skip the Patient Event Transport Information questions

 ; Input:   IBTRIEN     - IEN of the 356.22 entry being edited

 ; Returns: 1 - At least one field has a value, 0 otherwise

 N NDE

 S NDE=$G(^IBT(356.22,IBTRIEN,18))

 I $P(NDE,"^",1)'="" Q 1

 I $P(NDE,"^",2)'="" Q 1

 I $P(NDE,"^",3)'="" Q 1

 I $P(NDE,"^",4)'="" Q 1

 I $P(NDE,"^",5)'="" Q 1

 I $P(NDE,"^",6)'="" Q 1

 I $P(NDE,"^",9)'="" Q 1

 I $P(NDE,"^",10)'="" Q 1

 Q 0

 ;

SLDXDUP(FIELD)    ;EP

 ; Dictionary Screen Function

 ; Checks to see if the specified Service Line Diagnosis is a duplicate entry

 ; AND points to valid Diagnosis multiple.

 ; Fields: 2216,2.01, 2216,2.02, 2216,2.03, 2216,2.04 

 ; Input:   FIELD   - Field number of the field being checked

 ;          DA(1)   - IEN of the 356.22 entry being edited

 ;          DA      - IEN of the service line multiple

 ;          Y       - Internal Value of the user response

 ; Output:  None

 ; Returns: 1 - Answer is valid, 0 - Otherwise

 N NDE,RETURN

 S RETURN=1                                     ; Assume Valid Input

 Q:Y="" 1                                       ; No value entered

 ;

 ; Not a valid service line multiple

 I '$D(^IBT(356.22,DA(1),3,Y,0)) Q 0

 ;

 ; Check for duplicates

 S NDE=$G(^IBT(356.22,DA(1),16,DA,2))

 I FIELD="2.01" D  Q RETURN

 . I $P(NDE,"^",2)=Y S RETURN=0 Q

 . I $P(NDE,"^",3)=Y S RETURN=0 Q

 . I $P(NDE,"^",4)=Y S RETURN=0 Q

 I FIELD="2.02" D  Q RETURN

 . I $P(NDE,"^",1)=Y S RETURN=0 Q

 . I $P(NDE,"^",3)=Y S RETURN=0 Q

 . I $P(NDE,"^",4)=Y S RETURN=0 Q

 I FIELD="2.03" D  Q RETURN

 . I $P(NDE,"^",1)=Y S RETURN=0 Q

 . I $P(NDE,"^",2)=Y S RETURN=0 Q

 . I $P(NDE,"^",4)=Y S RETURN=0 Q

 I FIELD="2.04" D  Q RETURN

 . I $P(NDE,"^",1)=Y S RETURN=0 Q

 . I $P(NDE,"^",2)=Y S RETURN=0 Q

 . I $P(NDE,"^",3)=Y S RETURN=0 Q

 Q 1

 ;

TOOTHSP(FIELD) ;EP

 ; Called from Input Template IB CREATE 278 REQUEST for Service Line Tooth

 ; Surface fields. Checks to see if subsequent Tooth Surfaces have values.

 ; Input:   FIELD   - Field # of the field being checked

 ;          DA      - IEN of the Tooth multiple being edited

 ;          DA(1)   - IEN of the Service Line Multiple being edited

 ;          DA(2)   - IEN of the 356.22 entry being edited

 ; Returns: 1 - Subsequent entries have values, 0 otherwise

 N NDE,RETURN

 S NDE=$G(^IBT(356.22,DA(2),16,DA(1),4,DA,0))

 I FIELD=.02 D  Q RETURN

 . I $P(NDE,"^",2)'="" S RETURN=1 Q

 . I $P(NDE,"^",3)'="" S RETURN=1 Q

 . I $P(NDE,"^",4)'="" S RETURN=1 Q

 . I $P(NDE,"^",5)'="" S RETURN=1 Q

 . I $P(NDE,"^",6)'="" S RETURN=1 Q

 . S RETURN=0

 I FIELD=.03 D  Q RETURN

 . I $P(NDE,"^",4)'="" S RETURN=1 Q

 . I $P(NDE,"^",5)'="" S RETURN=1 Q

 . I $P(NDE,"^",6)'="" S RETURN=1 Q

 . S RETURN=0

 I FIELD=.04 D  Q RETURN

 . I $P(NDE,"^",5)'="" S RETURN=1 Q

 . I $P(NDE,"^",6)'="" S RETURN=1 Q

 . S RETURN=0

 I FIELD=.05,$P(NDE,"^",6)'="" Q 1

 Q 0

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBTRH5C   16328     printed  Feb 18, 2025@23:54:39                                                                                                                                                                                                    Page 2

IBTRH5C   ;ALB/FA - HCSR Create 278 Request ;12-AUG-2014

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

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

 +3       ;;

 +4       ; Contains Entry points and functions used in creating a 278 request from a

 +5       ; selected entry in the HCSR Response worklist

 +6       ;

 +7       ; --------------------------   Entry Points   --------------------------------

 +8       ; AMBTI        - Called from within the input template to see if any of the 

 +9       ;                Ambulance Transport Information fields have a value

 +10      ;                Fields: 18.01, 18.02, 18.03, 18.04, 18.05, 18.06, 18.09, 18.1 

 +11      ; ATTPHY       - Returns the Attending Physician of the entry

 +12      ; CERTCD       - Dictionary Screen function for Certification Type Code (2.02)

 +13      ; CONTPH       - Input Validation method for fields 20, 21, 22

 +14      ; CRTENTRY     - Creates a new worklist entry from a specified worklist entry.

 +15      ;                Copies all the request data from the specified entry into the

 +16      ;                new entry

 +17      ; OXYET        - Called from within the input template to determine if one of

 +18      ;                Oxygen Equipment Type fields = 'D' or 'E'. Fields 8.01, 8.02

 +19      ;                8.03

 +20      ; REQCAT       - Dictionary Screen function for Request Category Field 2.01

 +21      ;                and field 356.2216/.15

 +22      ; SLDXDUP      - Dictionary Screen function for Service Line Diagnosis fields

 +23      ;                Checks to insure the diagnosis is NOT a duplicate entry AND 

 +24      ;                points to a valid diagnosis multiple.

 +25      ;                Fields: 2216,2.01, 2216,2.02, 2216,2.03, 2216,2.04 

 +26      ; TOOTHSP      - Called from within the Input Template to check if subsequent

 +27      ;                Tooth Surfaces have values

 +28      ;-----------------------------------------------------------------------------

 +29      ;

CONTPH(FIELD) ;EP

 +1       ; Input validation method for Requester Contact Numbers 1,2 and 3 (fields 20,

 +2       ; 21 and 22)

 +3       ; Input:   FIELD   - Requester Contact Number field being validated

 +4       ;          DA      - IEN of the 356.22 entry being edited

 +5       ;          X       - Internal Value of the user response

 +6       ; Output:  None

 +7       ; Returns: 1 - Answer is valid, 0 - Otherwise

 +8        NEW RETURN,TYPE,XX

 +9        SET XX=$SELECT(FIELD=20:19.01,FIELD=21:19.02,FIELD=22:19.03,1:0)

 +10      ; Invalid FIELD

           if XX=0

               QUIT 0

 +11      ; Assume valid

           SET RETURN=1

 +12      ; Requester Contact Qualifier

           SET TYPE=$$GET1^DIQ(356.22,DA_",",XX,"I")

 +13      ; Requester Contact Qualifier Code

           SET TYPE=$$GET1^DIQ(365.021,TYPE_",",.01)

 +14      ;

 +15       IF (TYPE="ED")!(TYPE="EM")!(TYPE="UR")!(TYPE="EX")

               Begin DoDot:1

 +16               SET RETURN=$SELECT($LENGTH(X)'>250:1,1:0)

               End DoDot:1

               QUIT RETURN

 +17      ; Remove dashes

           SET XX=$TRANSLATE(X,"-","")

 +18       IF XX'?10N

               SET RETURN=0

 +19       QUIT RETURN

 +20      ;

CRTENTRY(IBTRIEN,RIEN,IEN312,REQBY,DELCCDE,DELAY,NOOUTPUT,TTYPE) ;EP

 +1       ; Creates a new entry in 356.22 by copying fields from an existing entry. Used

 +2       ; to create a request from a Response by copying the request entry pointed to

 +3       ; from the response entry

 +4       ; Input:   IBTRIEN - IEN of the entry to be copied

 +5       ;          RIEN    - IEN of the response entry

 +6       ;          IEN312  - IEN of the insurance multiple to set into field .03

 +7       ;                    Optional, if not passed, this field is copied from the

 +8       ;                    existing entry

 +9       ;          REQBY   - DUZ of the Requested By user to set into field .11

 +10      ;                    Optional, if not passed, this field is copied from the

 +11      ;                    existing entry

 +12      ;          DELCCDE - 1 to clear the value for Certification Type (field 2.02)

 +13      ;                    Optional, if not passed, defaults to 0

 +14      ;          DELAY   - 'D' or a future date to set a next review date and status

 +15      ;                    to '08'

 +16      ;                    Optional, if not passed, defaults to ""

 +17      ;          NOOUTPUT - suppress error message output, if not passed, defaults to 0 (false)

 +18      ;          TTYPE   - UM02 value for 278x215 if cancel

 +19      ;

 +20      ; Output:  New entry created in 356.22

 +21      ; Returns: 0 - Copy was NOT successful and error messages were displayed

 +22      ;          Otherwise, IEN of the new entry in 356.22 is returned

 +23       NEW ERROR,FLDS,IENARRY,IENS,NEWENTRY,NIENS,NIENS16,OLDENTRY,STOPFLG,XX,Z,Z1,XX1

 +24       if '$DATA(NOOUTPUT)

               SET NOOUTPUT=0

 +25       if '$DATA(IEN312)

               SET IEN312=""

 +26       if '$DATA(REQBY)

               SET REQBY=""

 +27       if '$DATA(DELCCDE)

               SET DELCCDE=0

 +28       if '$DATA(DELAY)

               SET DELAY=""

 +29       SET IENS=IBTRIEN_","

 +30       SET FLDS=".02;.03:.07;.11;.16;2.01:2.25;3*;4.01:4.14;5.01:5.18;6.01:6.18"

 +31       SET FLDS=FLDS_";7.01:7.13;8.01:8.08;9.01:9.08;10.01:10.13;11*;12;14*;15*;18.01:18.1;19.01:19.03;20:22"

 +32       DO GETS^DIQ(356.22,IENS,FLDS,"NI","OLDENTRY","ERROR")

 +33      ; Unsuccessful read of initial entry

           IF $DATA(ERROR)

               DO COPYERR(0,.ERROR)

               QUIT 0

 +34      ;

 +35      ; Copy internal data from the specified entry to a new array

 +36       MERGE NEWENTRY(356.22,"+1,")=OLDENTRY(356.22,IENS)

 +37       DO COPYINT(.NEWENTRY)

 +38      ;

 +39      ; Set the Event Date to 'NOW'

 +40       SET NEWENTRY(356.22,"+1,",.01)=$$NOW^XLFDT()

 +41      ; Set Insurance Multiple IEN

           if IEN312'=""

               SET NEWENTRY(356.22,"+1,",.03)=IEN312

 +42      ; Initialize status to 0

           SET NEWENTRY(356.22,"+1,",.08)=$SELECT(DELAY'="":"08",1:0)

 +43       if REQBY'=""

               SET NEWENTRY(356.22,"+1,",.11)=REQBY

 +44       IF DELCCDE

               Begin DoDot:1

 +45      ; Clear Certification Type field

                   SET NEWENTRY(356.22,"+1,",2.02)=""

 +46      ; Flag creation from Response

                   SET NEWENTRY(356.22,"+1,",.18)=1

               End DoDot:1

 +47       IF $GET(TTYPE)="C"

               SET NEWENTRY(356.22,"+1,",2.02)=3

 +48      ; Delayed until DELAY

           if DELAY'=""

               SET NEWENTRY(356.22,"+1,",.17)=DELAY

 +49      ; Auth. or Ref. number from response

           SET XX=$$GET1^DIQ(356.22,RIEN_",",103.02)

 +50      ; CERT ACT CODE

           SET XX1=$$GET1^DIQ(356.22,RIEN_",",103.01)

 +51       IF $FIND(",A1,A2,A6,",","_XX1_",")

               SET NEWENTRY(356.22,"+1,",17.01)=XX

 +52       IF $FIND(",A3,A4,C,CT,NA,",","_XX1_",")

               Begin DoDot:1

 +53               IF XX=""

                       SET XX=$$GET1^DIQ(356.22,RIEN_",",17.02)

 +54               SET NEWENTRY(356.22,"+1,",17.02)=XX

               End DoDot:1

 +55       KILL IENARRY

 +56      ; File the initial data

           DO UPDATE^DIE(,"NEWENTRY","IENARRY","ERROR")

 +57      ; Unsuccessful copy of initial data

           IF $DATA(ERROR)

               DO COPYERR(1,.ERROR)

               QUIT 0

 +58      ; update field .27 of response message

 +59       IF DELCCDE

               Begin DoDot:1

 +60               NEW UPDRSP

 +61               SET UPDRSP(356.22,RIEN_",",.27)=1

 +62               DO FILE^DIE("I","UPDRSP","ERROR")

 +63               QUIT 

               End DoDot:1

               IF $DATA(ERROR)

                   DO COPYERR(1,.ERROR)

                   QUIT 0

 +64      ;

 +65      ; Next copy multiples IENs of the new entry in 356.22 (top level)

 +66       SET NIENS=IENARRY(1)_","

 +67      ;

 +68      ; File Diagnosis multiples (356.223)

 +69       IF '$$MLTCPY(356.223,NIENS)

               QUIT 0

 +70      ;

 +71      ; File Attachment multiples (356.2211)

 +72       IF '$$MLTCPY(356.2211,NIENS)

               QUIT 0

 +73      ;

 +74      ; File Patient Event Transport multiples (356.2214)

 +75       IF '$$MLTCPY(356.2214,NIENS)

               QUIT 0

 +76      ;

 +77      ; File Other UMO multiples (356.2215)

 +78       IF '$$MLTCPY(356.2215,NIENS)

               QUIT 0

 +79      ;

 +80      ; File Provider multiples (356.2213)

 +81      ; NOTE: not all fields are being copied, each entry needs to be handled separately

 +82       SET Z=0

           SET STOPFLG=0

 +83       FOR 

               Begin DoDot:1

 +84               SET Z=$ORDER(^IBT(356.22,IBTRIEN,13,Z))

 +85               if 'Z

                       QUIT 

 +86               SET IENS=Z_","_IBTRIEN_","

 +87               KILL NEWENTRY,OLDENTRY

 +88               DO GETS^DIQ(356.2213,IENS,".01:.03","NI","OLDENTRY","ERROR")

 +89               IF $DATA(ERROR)

                       DO COPYERR(0,.ERROR)

                       SET STOPFLG=1

                       QUIT 

 +90               MERGE NEWENTRY(356.2213,"+1,"_NIENS)=OLDENTRY(356.2213,IENS)

 +91               DO COPYINT(.NEWENTRY)

 +92               DO UPDATE^DIE(,"NEWENTRY",,"ERROR")

 +93               IF $DATA(ERROR)

                       DO COPYERR(1,.ERROR)

                       SET STOPFLG=1

               End DoDot:1

               if 'Z!STOPFLG

                   QUIT 

 +94       if STOPFLG

               QUIT 0

 +95      ;

 +96      ; File Service Line multiples (356.2216)

 +97      ; NOTE: not all fields are being copied, each entry needs to be handled separately

 +98       SET Z=0

           SET STOPFLG=0

 +99       FOR 

               Begin DoDot:1

 +100              SET Z=$ORDER(^IBT(356.22,IBTRIEN,16,Z))

 +101              if 'Z

                       QUIT 

 +102              SET IENS=Z_","_IBTRIEN_","

 +103              KILL OLDENTRY

 +104              SET FLDS=".01:.14;1.01:1.12;2.01:2.09;3.01:3.07;4*;5.01:5.08;6*;7"

 +105              DO GETS^DIQ(356.2216,IENS,FLDS,"NI","OLDENTRY","ERROR")

 +106              IF $DATA(ERROR)

                       DO COPYERR(0,.ERROR)

                       SET STOPFLG=1

                       QUIT 

 +107              KILL NEWENTRY

 +108              MERGE NEWENTRY(356.2216,"+1,"_NIENS)=OLDENTRY(356.2216,IENS)

 +109              DO COPYINT(.NEWENTRY)

 +110              KILL IENARRY

 +111              DO UPDATE^DIE(,"NEWENTRY","IENARRY","ERROR")

 +112              IF $DATA(ERROR)

                       DO COPYERR(1,.ERROR)

                       SET STOPFLG=1

 +113     ; IENs of the new Service Line in 356.2216

                   SET NIENS16=IENARRY(1)_","_NIENS

 +114     ;

 +115     ; File Service Line Tooth Information multiples (356.22164)

 +116              IF '$$MLTCPY(356.22164,NIENS16)

                       SET STOPFLG=1

                       QUIT 

 +117     ;

 +118     ; File Service Line Attachment multiple (356.22166)

 +119              IF '$$MLTCPY(356.22166,NIENS16)

                       SET STOPFLG=1

                       QUIT 

 +120     ;

 +121     ; File Service Line Provider Data multiples (356.22168)

 +122     ; NOTE - not all fields are being copied, each entry needs to be handled separately

 +123              SET Z1=0

 +124              FOR 

                       Begin DoDot:2

 +125                      SET Z1=$ORDER(^IBT(356.22,IBTRIEN,16,Z,8,Z1))

 +126                      if 'Z1

                               QUIT 

 +127                      SET IENS=Z1_","_Z_","_IBTRIEN_","

 +128                      KILL NEWENTRY,OLDENTRY

 +129                      DO GETS^DIQ(356.22168,IENS,".01:.03","NI","OLDENTRY","ERROR")

 +130                      IF $DATA(ERROR)

                               DO COPYERR(0,.ERROR)

                               SET STOPFLG=1

                               QUIT 

 +131                      MERGE NEWENTRY(356.22168,"+1,"_NIENS16)=OLDENTRY(356.22168,IENS)

 +132                      DO COPYINT(.NEWENTRY)

 +133                      DO UPDATE^DIE(,"NEWENTRY",,"ERROR")

 +134                      IF $DATA(ERROR)

                               DO COPYERR(1,.ERROR)

                               SET STOPFLG=1

                       End DoDot:2

                       if 'Z1!STOPFLG

                           QUIT 

               End DoDot:1

               if 'Z!STOPFLG

                   QUIT 

 +135      IF STOPFLG

               QUIT 0

 +136      QUIT $PIECE(NIENS,",",1)

 +137     ;

COPYERR(TYPE,ERROR) ; Displays any errors encountered while copying a request

 +1       ; Input:   TYPE    - 0 - Error while reading data

 +2       ;                  - 1 - Error while filing data

 +3       ;          ERROR   - Array used for FM error reporting

 +4       ; Output:  Error(s) are displayed

 +5       ;IF NOT TO DISPLAY OUTPUT, for background job

           IF '$GET(NOOUTPUT)

               QUIT 

 +6        NEW STR,Z,Z1

 +7        if '$DATA(ERROR)

               QUIT 

 +8        WRITE !,"Unable to copy - the following error was encountered while "

 +9        WRITE $SELECT(TYPE:"filing",1:"retrieving")," the data:"

 +10       SET Z=0

 +11       FOR 

               Begin DoDot:1

 +12               SET Z=$ORDER(ERROR("DIERR",Z))

 +13               if 'Z

                       QUIT 

 +14               SET STR=$GET(ERROR("DIERR",Z))

 +15               if STR'=""

                       WRITE !,"Error code: "_STR

 +16               SET STR=$GET(ERROR("DIERR",Z,"PARAM","FILE"))

 +17               if STR'=""

                       WRITE !,"File number: "_STR

 +18               SET STR=$GET(ERROR("DIERR",Z,"PARAM","FIELD"))

 +19               if STR'=""

                       WRITE !,"Field number: "_STR

 +20               WRITE !,"Error text:"

 +21               SET Z1=0

 +22               FOR 

                       Begin DoDot:2

 +23                       SET Z1=$ORDER(ERROR("DIERR",1,"TEXT",Z1))

 +24                       if 'Z1

                               QUIT 

 +25                       WRITE !,ERROR("DIERR",1,"TEXT",Z1)

                       End DoDot:2

                       if 'Z1

                           QUIT 

               End DoDot:1

               if 'Z

                   QUIT 

 +26       QUIT 

 +27      ;

MLTCPY(SFNUM,NEWIENS) ; Copies the specified multiple 

 +1       ; Input:   SFNUM       - Sub-file number of the multiple to copy

 +2       ;          NIENS       - IENs of the new entry (copied to)

 +3       ;          OLDENTRY    - FDA array to get data from (defined in the calling tag)

 +4       ; Returns: 1 on successful copy, 0 on failure

 +5       ;

 +6        NEW ERROR,NEWENTRY,RES,STOPFLG,Z

 +7        SET RES=1

           SET STOPFLG=0

 +8        SET Z=0

 +9        FOR 

               Begin DoDot:1

 +10               SET Z=$ORDER(OLDENTRY(SFNUM,Z))

 +11               if 'Z

                       QUIT 

 +12               KILL NEWENTRY

 +13               MERGE NEWENTRY(SFNUM,"+1,"_NEWIENS)=OLDENTRY(SFNUM,Z)

 +14               DO COPYINT(.NEWENTRY)