SDPMUT2.m

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 ---SDPMUT2   2829     printed  Feb 19, 2025@00:26:07                                                                                                                                                                                                     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