144 lines
4.3 KiB
Mathematica
144 lines
4.3 KiB
Mathematica
SCMCHLB1 ;BPOI/DJB - PCMM HL7 Bld Segment Array Cont.;8/17/99
|
|
;;5.3;Scheduling;**177,515,524**;08/17/99;Build 29
|
|
;
|
|
SEGMENTS(DFN,SUB) ;Build EVN & PID segments
|
|
;Input:
|
|
; DFN - Patient IEN
|
|
; SUB - Value for 1st Subscript
|
|
;Output:
|
|
; XMITARRY() - Array of EVN & PID segments
|
|
;
|
|
NEW LINETAG,SEGMENTS,SEGNAME,SEGORD
|
|
NEW EVNTDATE,EVNTHL7,VAFARRY,VAFEVN,VAFPID,VAFSTR
|
|
;
|
|
;Initialize variables
|
|
Q:'$G(DFN) ;Required for PID segment
|
|
Q:'$G(SUB)
|
|
S EVNTDATE=DT
|
|
S EVNTHL7="A08"
|
|
;
|
|
;Get array of segments to be built
|
|
D SEGMENTS^SCMCHLS(EVNTHL7,"SEGMENTS")
|
|
;
|
|
;Loop thru segments array. Ignore ZPC segment - already built.
|
|
S SEGORD=0
|
|
F S SEGORD=+$O(SEGMENTS(SEGORD)) Q:'SEGORD D ;
|
|
. S SEGNAME=""
|
|
. F S SEGNAME=$O(SEGMENTS(SEGORD,SEGNAME)) Q:SEGNAME="" D ;
|
|
.. Q:SEGNAME="ZPC" ;.................ZPC already built
|
|
.. S VAFSTR=SEGMENTS(SEGORD,SEGNAME) ;String of segment fields
|
|
.. S LINETAG="BLD"_SEGNAME
|
|
.. D @LINETAG^SCMCHLS ;...............Build segment
|
|
.. S LINETAG="CPY"_SEGNAME
|
|
.. D @LINETAG^SCMCHLS ;...............Copy segment into array
|
|
Q
|
|
;
|
|
ZPC(ARRAY,DELETE) ;Loop thru array and build array of ZPC segments.
|
|
;
|
|
;Input:
|
|
; ARRAY - Array to be processed. This array was built in ^SCMCHLB
|
|
; with calls to $$PRTPC^SCAPMC() and $$PRPTTPC^SCAPMC().
|
|
; Examples:
|
|
; ARRAY(2290,"PCP","2290-406-34-PCP")= Data
|
|
; ARRAY(345,"PROV-P","2290-405-0-AP")= Data
|
|
; DELETE - 1=Process a delete type ZPC segment (all fields null)
|
|
;Output:
|
|
; Array of ZPC segments
|
|
;
|
|
NEW DATA,DATE,ID,ID1,LINETAG,SUB,TYPE,VAFZPC
|
|
;
|
|
S SUB=0
|
|
F S SUB=$O(ARRAY(SUB)) Q:'SUB D ;
|
|
. S TYPE=""
|
|
. F S TYPE=$O(ARRAY(SUB,TYPE)) Q:TYPE="" D ;
|
|
.. S ID=""
|
|
.. F S ID=$O(ARRAY(SUB,TYPE,ID)) Q:ID="" D ;
|
|
... S DATA=$G(ARRAY(SUB,TYPE,ID))
|
|
... I $G(DELETE) S DATA="^^^" ;A Delete type ZPC segment
|
|
... E D ;....................A ZPC segment with data
|
|
.... ;Get dates
|
|
.... S DATE(9)=$P(DATA,U,9)
|
|
.... S DATE(10)=$P(DATA,U,10)
|
|
.... S DATE(14)=$P(DATA,U,14) ;Preceptor start date
|
|
.... S DATE(15)=$P(DATA,U,15) ;Preceptor end date
|
|
.... I DATE(14),DATE(14)>DATE(9) S DATE(9)=DATE(14)
|
|
.... I DATE(15) D ;
|
|
..... I 'DATE(10) S DATE(10)=DATE(15) Q
|
|
..... I DATE(15)<DATE(10) S DATE(10)=DATE(15)
|
|
.... ;
|
|
.... ;Provider^AssignDate^UnassignDate^ProviderType
|
|
.... S DATA=$P(DATA,U,1)_"^"_DATE(9)_"^"_DATE(10)
|
|
....; PATCH 515 DLL ADD NEW ROLES (TPA,CCM,PM)
|
|
....; OLD CODE = S DATA=DATA_"^"_$S(ID["AP":"AP",1:"PCP")
|
|
....S ROLE=$P(ID,"-",4) I $G(ROLE)="" S ROLE="PCP"
|
|
....S DATA=DATA_"^"_ROLE
|
|
... ;
|
|
... D BLDZPC^SCMCHLS ;..Build segment ; og/sd/524
|
|
... D CPYZPC^SCMCHLS ;..Copy segment into array ; og/sd/524
|
|
Q
|
|
;
|
|
DFN(ND) ;Find DFN from zero node of Patient Team Position Assign (404.43).
|
|
;Input:
|
|
; ND - Zero node of 404.43
|
|
;Output:
|
|
; DFN - Patient IEN
|
|
; "" - No valid DFN found
|
|
;
|
|
S DFN=$P(ND,U,1)
|
|
I DFN S DFN=$P($G(^SCPT(404.42,DFN,0)),U,1)
|
|
Q DFN
|
|
;
|
|
ADJID(ARRAY,SCIEN) ;Adjust ID to include Pt Tm Pos Assign pointer
|
|
;Example: From this: 424-34-AP
|
|
; To this: 2290-424-34-AP
|
|
;Input:
|
|
; ARRAY - Array to be processed
|
|
; SCIEN - 404.43 IEN to be added to ID
|
|
;
|
|
NEW ADJID,ID,NUM,TMP,TYPE
|
|
;
|
|
;Build TMP() array using adjusted ID
|
|
S NUM=0
|
|
F S NUM=$O(ARRAY(NUM)) Q:'NUM D ;
|
|
. S TYPE=""
|
|
. F S TYPE=$O(ARRAY(NUM,TYPE)) Q:TYPE="" D ;
|
|
.. S ID=""
|
|
.. F S ID=$O(ARRAY(NUM,TYPE,ID)) Q:ID="" D ;
|
|
... S ADJID=SCIEN_"-"_ID ;..Add 404.43 IEN
|
|
... S TMP(NUM,TYPE,ADJID)=ARRAY(NUM,TYPE,ID)
|
|
;
|
|
;Replace ARRAY() with adjusted TMP() array.
|
|
Q:'$D(TMP)
|
|
KILL ARRAY
|
|
M ARRAY=TMP ;Copy TMP() into ARRAY()
|
|
Q
|
|
;
|
|
CHECK(VARPTR) ;Validate event variable pointer.
|
|
;Input:
|
|
; VARPTR - EVENT POINTER field of PCMM HL7 EVENT (#404.48)
|
|
;Output:
|
|
; SCIEN - IEN portion of variable pointer
|
|
; SCGLB - Global portion of variable pointer
|
|
;Return:
|
|
; 0: Invalid variable pointer format
|
|
; 1: Valid pointer
|
|
; 2: No data. Entry has been deleted. Send a delete to NPCD.
|
|
;
|
|
NEW CHK,GLB
|
|
;
|
|
S SCIEN=$P(VARPTR,";") ;....IEN portion of variable pointer
|
|
S SCGLB=$P(VARPTR,";",2) ;..Global portion of variable pointer
|
|
;
|
|
;Return zero if variable pointer is invalid.
|
|
I 'SCIEN Q 0
|
|
S CHK=0 D I CHK Q 0
|
|
. Q:SCGLB="SCPT(404.43,"
|
|
. Q:SCGLB="SCTM(404.52,"
|
|
. Q:SCGLB="SCTM(404.53,"
|
|
. S CHK=1
|
|
;
|
|
;Is there data for this IEN?
|
|
S GLB="^"_SCGLB_SCIEN_",0)"
|
|
I '$D(@GLB) Q 2 ;..Entry has been deleted
|
|
Q 1
|