SDPMUT2 ;BPFO/JRC - Performance Monitors Utilities ; 11/3/03 3:24pm
;;5.3;SCHEDULING;**292,322,474**;AUGUST 13, 1993;Build 4
;
SCREEN(PTRENC,SCRNARR) ;Screen Outpatient Encounter
;Input : PTRENC - Outpatient Encounter IEN
; SCRNARR - Screening array full global reference
;Output : 1 = Screen encounter out
; 0 = Keep encounter and process
;
;Declare variables
N PCODE,SCODE,CLINIC,NODE,Y,I,CHLD,PROV,TYPE
S NODE=$G(^SCE(PTRENC,0))
;Can not be test patient
I $$TESTPAT^VADPT($P(NODE,U,2)) Q 1
;Encounter must be checked out
I '$P(NODE,U,7) Q 1
;Can't be child encounter
I +$P(NODE,U,6) Q 1
;Screen out non-count clinics
S CLINIC=$P($G(NODE),U,4)
I 'CLINIC Q 1
I $P($G(^SC(CLINIC,0)),U,17)="Y" Q 1
;Appointment type must be regular or service connected
;service connected added - SD*5.3*474
I $P($G(NODE),U,10) S TYPE=$P($G(^SD(409.1,$P($G(NODE),U,10),0)),U,1)
I '$D(TYPE) Q 1
I TYPE'["REGULAR" I TYPE'["SERVICE CONNECTED" Q 1
;Get primary & secondary stop codes
S PCODE=+$P(NODE,U,3)
S CHLD=+$O(^SCE("APAR",PTRENC,0))
S SCODE=0
I CHLD D
.S SCODE=+$P($G(^SCE(CHLD,0)),U,3)
;Check stop codes (in inclusion list and/or not in exclusion list)
S Y=$S($O(@SCRNARR@("DSS",0)):1,$O(@SCRNARR@("DSS-PAIR",0)):1,1:0)
I 'PCODE Q 1
I @SCRNARR@("DSS")=1 S Y=0
I $D(@SCRNARR@("DSS",PCODE)) S Y=0
I $D(@SCRNARR@("DSS-EXCLUDE",PCODE))!$D(@SCRNARR@("DSS-EXCLUDE",SCODE)) S Y=1
I Y Q 1
;Check division (must be in list)
S Y=1
S DIV=$P(NODE,U,11)
I 'DIV Q 1
I @SCRNARR@("DIVISION")=1 S Y=0
I $D(@SCRNARR@("DIVISION",DIV)) S Y=0
I Y Q 1
;Get primary encounter provider
S Y=1
S PROV=$$ENCPROV(PTRENC)
;Check primary encounter provider (must be in list)
I 'PROV Q 1
I @SCRNARR@("PROVIDERS")=1 S Y=0
I $D(@SCRNARR@("PROVIDERS",PROV)) S Y=0
I Y Q 1
;Passed all screens
Q 0
;
NOTEINF(PTRENC) ;Returns performance monitor information for a given encounter
;Input : PTRENC - Outpatient Encounter IEN
;Output: Results of calling $$PM^TIUPXPM
; String with 6 fields ('^' delimiter)
; 1 VIEN
; 2 Note Category (A-E)
; 3 Signed By (pointer to File #200)
; 4 Signed Date.Time (FM format)
; 5 Co-signed By (pointer to File #200) - defined only if necessary
; 6 Co-signed Date.Time - defined only if necessary
;
N VIEN
S VIEN=$P(^SCE(PTRENC,0),U,5)
Q $$PM^TIUPXPM(VIEN)
;
ENCPROV(PTRENC) ;Return primary encounter provider
;Input : ENCPTR - Pointer to Outpatient Encounter
;Output : Pointer to New Person File
;Note : 0 returned if primary encounter provider not found
N NODE,PROV,X
D GETPRV^SDOE(PTRENC,"NODE")
S PROV=0
S X=0 F S X=+$O(NODE(X)) Q:'X D Q:PROV
.I $P(NODE(X),"^",4)="P" S PROV=+NODE(X)
Q PROV
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPMUT2 2829 printed Apr 09, 2024@22:01:25 Page 2
SDPMUT2 ;BPFO/JRC - Performance Monitors Utilities ; 11/3/03 3:24pm
+1 ;;5.3;SCHEDULING;**292,322,474**;AUGUST 13, 1993;Build 4
+2 ;
SCREEN(PTRENC,SCRNARR) ;Screen Outpatient Encounter
+1 ;Input : PTRENC - Outpatient Encounter IEN
+2 ; SCRNARR - Screening array full global reference
+3 ;Output : 1 = Screen encounter out
+4 ; 0 = Keep encounter and process
+5 ;
+6 ;Declare variables
+7 NEW PCODE,SCODE,CLINIC,NODE,Y,I,CHLD,PROV,TYPE
+8 SET NODE=$GET(^SCE(PTRENC,0))
+9 ;Can not be test patient
+10 IF $$TESTPAT^VADPT($PIECE(NODE,U,2))
QUIT 1
+11 ;Encounter must be checked out
+12 IF '$PIECE(NODE,U,7)
QUIT 1
+13 ;Can't be child encounter
+14 IF +$PIECE(NODE,U,6)
QUIT 1
+15 ;Screen out non-count clinics
+16 SET CLINIC=$PIECE($GET(NODE),U,4)
+17 IF 'CLINIC
QUIT 1
+18 IF $PIECE($GET(^SC(CLINIC,0)),U,17)="Y"
QUIT 1
+19 ;Appointment type must be regular or service connected
+20 ;service connected added - SD*5.3*474
+21 IF $PIECE($GET(NODE),U,10)
SET TYPE=$PIECE($GET(^SD(409.1,$PIECE($GET(NODE),U,10),0)),U,1)
+22 IF '$DATA(TYPE)
QUIT 1
+23 IF TYPE'["REGULAR"
IF TYPE'["SERVICE CONNECTED"
QUIT 1
+24 ;Get primary & secondary stop codes
+25 SET PCODE=+$PIECE(NODE,U,3)
+26 SET CHLD=+$ORDER(^SCE("APAR",PTRENC,0))
+27 SET SCODE=0
+28 IF CHLD
Begin DoDot:1
+29 SET SCODE=+$PIECE($GET(^SCE(CHLD,0)),U,3)
End DoDot:1
+30 ;Check stop codes (in inclusion list and/or not in exclusion list)
+31 SET Y=$SELECT($ORDER(@SCRNARR@("DSS",0)):1,$ORDER(@SCRNARR@("DSS-PAIR",0)):1,1:0)
+32 IF 'PCODE
QUIT 1
+33 IF @SCRNARR@("DSS")=1
SET Y=0
+34 IF $DATA(@SCRNARR@("DSS",PCODE))
SET Y=0
+35 IF $DATA(@SCRNARR@("DSS-EXCLUDE",PCODE))!$DATA(@SCRNARR@("DSS-EXCLUDE",SCODE))
SET Y=1
+36 IF Y
QUIT 1
+37 ;Check division (must be in list)
+38 SET Y=1
+39 SET DIV=$PIECE(NODE,U,11)
+40 IF 'DIV
QUIT 1
+41 IF @SCRNARR@("DIVISION")=1
SET Y=0
+42 IF $DATA(@SCRNARR@("DIVISION",DIV))
SET Y=0
+43 IF Y
QUIT 1
+44 ;Get primary encounter provider
+45 SET Y=1
+46 SET PROV=$$ENCPROV(PTRENC)
+47 ;Check primary encounter provider (must be in list)
+48 IF 'PROV
QUIT 1
+49 IF @SCRNARR@("PROVIDERS")=1
SET Y=0
+50 IF $DATA(@SCRNARR@("PROVIDERS",PROV))
SET Y=0
+51 IF Y
QUIT 1
+52 ;Passed all screens
+53 QUIT 0
+54 ;
NOTEINF(PTRENC) ;Returns performance monitor information for a given encounter
+1 ;Input : PTRENC - Outpatient Encounter IEN
+2 ;Output: Results of calling $$PM^TIUPXPM
+3 ; String with 6 fields ('^' delimiter)
+4 ; 1 VIEN
+5 ; 2 Note Category (A-E)
+6 ; 3 Signed By (pointer to File #200)
+7 ; 4 Signed Date.Time (FM format)
+8 ; 5 Co-signed By (pointer to File #200) - defined only if necessary
+9 ; 6 Co-signed Date.Time - defined only if necessary
+10 ;
+11 NEW VIEN
+12 SET VIEN=$PIECE(^SCE(PTRENC,0),U,5)
+13 QUIT $$PM^TIUPXPM(VIEN)
+14 ;
ENCPROV(PTRENC) ;Return primary encounter provider
+1 ;Input : ENCPTR - Pointer to Outpatient Encounter
+2 ;Output : Pointer to New Person File
+3 ;Note : 0 returned if primary encounter provider not found
+4 NEW NODE,PROV,X
+5 DO GETPRV^SDOE(PTRENC,"NODE")
+6 SET PROV=0
+7 SET X=0
FOR
SET X=+$ORDER(NODE(X))
if 'X
QUIT
Begin DoDot:1
+8 IF $PIECE(NODE(X),"^",4)="P"
SET PROV=+NODE(X)
End DoDot:1
if PROV
QUIT
+9 QUIT PROV
