- IBDF18E4 ;ALB/DHH - ENCOUNTER FORM - MISC INTERFACES utilities ;19-JUN-01
- ;;3.0;AUTOMATED INFO COLLECTION SYS;**37**;APR 24, 1997
- ;
- ;-- this routine is to be called after PXCA is called in order to
- ; send additional information to other packages that PCE does not
- ; send to currently
- ;
- GAF ;send GAF information to Mental Health
- ;
- ;-- GAF information is filed with Mental Health only if the following
- ; variables are set
- ; -- DFN = Patient IEN
- ; SCORE = GAF Score
- ; PROV = Provider holding SD GAF SCORE security key
- ; DATE = Encounter Date/Time
- ; VISIT = Inpatient or Outpatient Visit
- ;
- N DIG1,DIG2,DIG3,EPROV,SCORE,PROV,DATE,VISIT,X,DFN
- S (SCORE,PROV,DATE,VISIT)=""
- ;
- ; --if pxca (ibd gaf score col 3) exist the there should be 3
- ; columns present to make the 3 character number
- ;
- I $D(PXCA("IBD GAF SCORE COL 3")) D
- . ;
- . S (DIG1,DIG2,DIG3)=""
- . ;
- . ; checking to see if column 3 is existing
- . ; column 1 and 2 are not required to make score
- . ;
- . Q:'$D(PXCA("IBD GAF SCORE COL 3"))
- . S EPROV="" F S EPROV=$O(PXCA("IBD GAF SCORE COL 3",EPROV)) Q:EPROV="" D
- .. ;
- .. S DIG1=$P($G(PXCA("IBD GAF SCORE COL 1",EPROV,+$O(PXCA("IBD GAF SCORE COL 1",EPROV,0)))),"^",1)
- .. S DIG2=$P($G(PXCA("IBD GAF SCORE COL 2",EPROV,+$O(PXCA("IBD GAF SCORE COL 2",EPROV,0)))),"^",1)
- .. S DIG3=$P($G(PXCA("IBD GAF SCORE COL 3",EPROV,+$O(PXCA("IBD GAF SCORE COL 3",EPROV,0)))),"^",1)
- .. S SCORE=DIG1_DIG2_DIG3
- .. ;
- .. ; -- score is required to be 1-100
- .. ;
- .. I SCORE>100 S SCORE=""
- .. S PXCA("IBD GAF SCORE COL 1",EPROV,1)=SCORE
- .. ;
- I $D(PXCA("IBD GAF SCORE COL 1")) D
- . S EPROV="" F S EPROV=$O(PXCA("IBD GAF SCORE COL 1",EPROV)) Q:EPROV="" D
- .. S SCORE=$P($G(PXCA("IBD GAF SCORE COL 1",EPROV,+$O(PXCA("IBD GAF SCORE COL 1",EPROV,0)))),"^")
- .. S PROV=$P($G(PXCA("IBD GAF SCORE PROVIDER",EPROV,+$O(PXCA("IBD GAF SCORE PROVIDER",EPROV,0)))),"^")
- .. S DFN=$P($G(PXCA("ENCOUNTER")),"^",2)
- .. S DATE=$P($G(PXCA("ENCOUNTER")),"^",14)
- .. S VISIT=$S($P($G(PXCA("ENCOUNTER")),"^",3)="W":"I",1:"O")
- .. ;
- .. ; do error check and file error quit if error
- .. ; -- if any mandated information is missing file an error
- .. ; in AICS' error log.
- .. ;
- .. I DFN="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
- .. I SCORE>100!(SCORE<1) D LOGERR^IBDF18E2(3570005,.FORMID) Q
- .. I DATE="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
- .. I PROV="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
- .. I VISIT="" D LOGERR^IBDF18E2(3570005,.FORMID) Q
- .. D UPD^YSGAF(DFN,SCORE,DATE,PROV,VISIT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF18E4 2609 printed Jan 18, 2025@03:52:11 Page 2
- IBDF18E4 ;ALB/DHH - ENCOUNTER FORM - MISC INTERFACES utilities ;19-JUN-01
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**37**;APR 24, 1997
- +2 ;
- +3 ;-- this routine is to be called after PXCA is called in order to
- +4 ; send additional information to other packages that PCE does not
- +5 ; send to currently
- +6 ;
- GAF ;send GAF information to Mental Health
- +1 ;
- +2 ;-- GAF information is filed with Mental Health only if the following
- +3 ; variables are set
- +4 ; -- DFN = Patient IEN
- +5 ; SCORE = GAF Score
- +6 ; PROV = Provider holding SD GAF SCORE security key
- +7 ; DATE = Encounter Date/Time
- +8 ; VISIT = Inpatient or Outpatient Visit
- +9 ;
- +10 NEW DIG1,DIG2,DIG3,EPROV,SCORE,PROV,DATE,VISIT,X,DFN
- +11 SET (SCORE,PROV,DATE,VISIT)=""
- +12 ;
- +13 ; --if pxca (ibd gaf score col 3) exist the there should be 3
- +14 ; columns present to make the 3 character number
- +15 ;
- +16 IF $DATA(PXCA("IBD GAF SCORE COL 3"))
- Begin DoDot:1
- +17 ;
- +18 SET (DIG1,DIG2,DIG3)=""
- +19 ;
- +20 ; checking to see if column 3 is existing
- +21 ; column 1 and 2 are not required to make score
- +22 ;
- +23 if '$DATA(PXCA("IBD GAF SCORE COL 3"))
- QUIT
- +24 SET EPROV=""
- FOR
- SET EPROV=$ORDER(PXCA("IBD GAF SCORE COL 3",EPROV))
- if EPROV=""
- QUIT
- Begin DoDot:2
- +25 ;
- +26 SET DIG1=$PIECE($GET(PXCA("IBD GAF SCORE COL 1",EPROV,+$ORDER(PXCA("IBD GAF SCORE COL 1",EPROV,0)))),"^",1)
- +27 SET DIG2=$PIECE($GET(PXCA("IBD GAF SCORE COL 2",EPROV,+$ORDER(PXCA("IBD GAF SCORE COL 2",EPROV,0)))),"^",1)
- +28 SET DIG3=$PIECE($GET(PXCA("IBD GAF SCORE COL 3",EPROV,+$ORDER(PXCA("IBD GAF SCORE COL 3",EPROV,0)))),"^",1)
- +29 SET SCORE=DIG1_DIG2_DIG3
- +30 ;
- +31 ; -- score is required to be 1-100
- +32 ;
- +33 IF SCORE>100
- SET SCORE=""
- +34 SET PXCA("IBD GAF SCORE COL 1",EPROV,1)=SCORE
- +35 ;
- End DoDot:2
- End DoDot:1
- +36 IF $DATA(PXCA("IBD GAF SCORE COL 1"))
- Begin DoDot:1
- +37 SET EPROV=""
- FOR
- SET EPROV=$ORDER(PXCA("IBD GAF SCORE COL 1",EPROV))
- if EPROV=""
- QUIT
- Begin DoDot:2
- +38 SET SCORE=$PIECE($GET(PXCA("IBD GAF SCORE COL 1",EPROV,+$ORDER(PXCA("IBD GAF SCORE COL 1",EPROV,0)))),"^")
- +39 SET PROV=$PIECE($GET(PXCA("IBD GAF SCORE PROVIDER",EPROV,+$ORDER(PXCA("IBD GAF SCORE PROVIDER",EPROV,0)))),"^")
- +40 SET DFN=$PIECE($GET(PXCA("ENCOUNTER")),"^",2)
- +41 SET DATE=$PIECE($GET(PXCA("ENCOUNTER")),"^",14)
- +42 SET VISIT=$SELECT($PIECE($GET(PXCA("ENCOUNTER")),"^",3)="W":"I",1:"O")
- +43 ;
- +44 ; do error check and file error quit if error
- +45 ; -- if any mandated information is missing file an error
- +46 ; in AICS' error log.
- +47 ;
- +48 IF DFN=""
- DO LOGERR^IBDF18E2(3570005,.FORMID)
- QUIT
- +49 IF SCORE>100!(SCORE<1)
- DO LOGERR^IBDF18E2(3570005,.FORMID)
- QUIT
- +50 IF DATE=""
- DO LOGERR^IBDF18E2(3570005,.FORMID)
- QUIT
- +51 IF PROV=""
- DO LOGERR^IBDF18E2(3570005,.FORMID)
- QUIT
- +52 IF VISIT=""
- DO LOGERR^IBDF18E2(3570005,.FORMID)
- QUIT
- +53 DO UPD^YSGAF(DFN,SCORE,DATE,PROV,VISIT)
- End DoDot:2
- End DoDot:1
- +54 QUIT