AQAOCID.m

AQAOCID ; IHS/ORDC/LJF - CREATE COMPUTED NUMBERS 4 FILES ; [ 09/01/1998  6:37 PM ]

 ;;1.01;QAI MANAGEMENT;**1**;OCT 05, 1995

 ;

 ;This rtn is a PRIVATE ENTRY POINT for computing the case ID

 ;number for an occurrence.  The entry is called using $$OCCID^AQAOCID.

 ;

OCCID() ;PEP;PRIVATE ENTRY POINT for EXTR VAR to create occurrence id number

 ;private published entry point: can only be called by AQAL pkg

 ;REQUIRED INPUT:   AQAOPAT=PATIENT DFN

 ;                  AQAODATE=OCCURRENCE DATE

 ;                  AQAOIND=INDICATOR

 ;

MONTH ; (1) MONTH OF OCCURRENCE (ALPHA A THROUGH L)

 S AQAOCID=$C($E(AQAODATE,4,5)+64)

 ;

DAY ; (2) DAY OF OCCURRENCE (ALPHA A THROUGH Z, 27=1,28=2,29=3,30=4,31=5) 

 S AQAODAY=$E(AQAODATE,6,7)

 S AQAOCID=AQAOCID_$S(AQAODAY>26:AQAODAY-26,1:$C(AQAODAY+64))

 ;

LNAME ; (3) LAST NAME (FIRST LETTER OF LAST NAME)

 S AQAONAM=$P($G(^DPT(AQAOPAT,0)),U) S:AQAONAM="" AQAONAM="Z"

 S AQAOCID=AQAOCID_$E(AQAONAM)

 ;

FUDGE ; (4-7) RANDOM 3-DIGIT NUMBER; THEN CHECK IF UNIQUE

 S X=AQAOCID_$R(9999) I $D(^AQAOC("B",X)) G FUDGE ;PATCH 1 w/ next line

 Q X

 ;

 ;

NEWAP() ;ENTRY POINT for EXTR VAR to create action plan number

 ;

 N %H,Y,X

 ;first get facility's abbreviation

 S AQAOAPN=$P($G(^AUTTLOC(DUZ(2),0)),U,2)_"QI",AQAOAPN=$E(AQAOAPN,1,4)

 ;Begin Y2K patch ;IHS/DIR/JLG 9/1/98

 ;S %H=$H D YMD^%DTC S Y=$E(X,2,3) I $E(X,4,5)>9 S Y=Y+1 ;fiscal year

 S Y=$E($$FISCAL^XBDT($H),3,4)            ;Y2000

 ;End Y2K patch   ;IHS/DIR/JLG

 S (X,Y,AQAOAPN)=AQAOAPN_Y_"1000"

 F  S X=$O(^AQAO(5,"B",X)) Q:X=""  Q:($E(X,5,6)>$E(AQAOAPN,5,6))  S Y=X

 S AQAOAPN=$E(AQAOAPN,1,6)_($E(Y,7,10)+1)

 I $L(AQAOAPN)'=10 S AQAOAPN=""

 Q AQAOAPN

AQAOCID   ; IHS/ORDC/LJF - CREATE COMPUTED NUMBERS 4 FILES ; [ 09/01/1998  6:37 PM ]

 +1       ;;1.01;QAI MANAGEMENT;**1**;OCT 05, 1995

 +2       ;

 +3       ;This rtn is a PRIVATE ENTRY POINT for computing the case ID

 +4       ;number for an occurrence.  The entry is called using $$OCCID^AQAOCID.

 +5       ;

OCCID()   ;PEP;PRIVATE ENTRY POINT for EXTR VAR to create occurrence id number

 +1       ;private published entry point: can only be called by AQAL pkg

 +2       ;REQUIRED INPUT:   AQAOPAT=PATIENT DFN

 +3       ;                  AQAODATE=OCCURRENCE DATE

 +4       ;                  AQAOIND=INDICATOR

 +5       ;

MONTH     ; (1) MONTH OF OCCURRENCE (ALPHA A THROUGH L)

 +1        SET AQAOCID=$CHAR($EXTRACT(AQAODATE,4,5)+64)

 +2       ;

DAY       ; (2) DAY OF OCCURRENCE (ALPHA A THROUGH Z, 27=1,28=2,29=3,30=4,31=5) 

 +1        SET AQAODAY=$EXTRACT(AQAODATE,6,7)

 +2        SET AQAOCID=AQAOCID_$SELECT(AQAODAY>26:AQAODAY-26,1:$CHAR(AQAODAY+64))

 +3       ;

LNAME     ; (3) LAST NAME (FIRST LETTER OF LAST NAME)

 +1        SET AQAONAM=$PIECE($GET(^DPT(AQAOPAT,0)),U)

           IF AQAONAM=""

               SET AQAONAM="Z"

 +2        SET AQAOCID=AQAOCID_$EXTRACT(AQAONAM)

 +3       ;

FUDGE     ; (4-7) RANDOM 3-DIGIT NUMBER; THEN CHECK IF UNIQUE

 +1       ;PATCH 1 w/ next line

           SET X=AQAOCID_$RANDOM(9999)

           IF $DATA(^AQAOC("B",X))

               GOTO FUDGE

 +2        QUIT X

 +3       ;

 +4       ;

NEWAP()   ;ENTRY POINT for EXTR VAR to create action plan number

 +1       ;

 +2        NEW %H,Y,X

 +3       ;first get facility's abbreviation

 +4        SET AQAOAPN=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,2)_"QI"

           SET AQAOAPN=$EXTRACT(AQAOAPN,1,4)

 +5       ;Begin Y2K patch ;IHS/DIR/JLG 9/1/98

 +6       ;S %H=$H D YMD^%DTC S Y=$E(X,2,3) I $E(X,4,5)>9 S Y=Y+1 ;fiscal year

 +7       ;Y2000

           SET Y=$EXTRACT($$FISCAL^XBDT($HOROLOG),3,4)

 +8       ;End Y2K patch   ;IHS/DIR/JLG

 +9        SET (X,Y,AQAOAPN)=AQAOAPN_Y_"1000"

 +10       FOR 

               SET X=$ORDER(^AQAO(5,"B",X))

               IF X=""

                   QUIT 

               IF ($EXTRACT(X,5,6)>$EXTRACT(AQAOAPN,5,6))

                   QUIT 

               SET Y=X

 +11       SET AQAOAPN=$EXTRACT(AQAOAPN,1,6)_($EXTRACT(Y,7,10)+1)

 +12       IF $LENGTH(AQAOAPN)'=10

               SET AQAOAPN=""

 +13       QUIT AQAOAPN