AQAOBUL.m

AQAOBUL ; IHS/ORDC/LJF - BULLETIN ON PERSONAL REFERRAL ;

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

 ;

 ;This rtn contains 4 entry points called by MUMPS xrefs to send

 ;bulletins to persons to whom an occurrence case has been referred.

 ;Called by the 4 referred to fields.

 ;

INITIAL ;ENTRY POINT for initial review

 Q:X=""  Q:X'["AQAO(9"  ;not referred to a person

 S XMB(4)=$P(^AQAOC(DA,1),U,4)

 S XMB(4)=U_$P(XMB(4),";",2)_+XMB(4)_",0)"

 S XMB(4)=$P(@XMB(4),U) ;referred by - variable pointer

 S AQAODA=DA D VAR,^XMB Q

 ;

 ;

ADDREV ;ENTRY POINT for additional referrals on initial review

 Q:X=""  Q:X'["AQAO(9"  ;not referred to a person

 S XMB(4)=$P(^AQAOC(DA(1),1),U,4)

 S XMB(4)=U_$P(XMB(4),";",2)_+XMB(4)_",0)"

 S XMB(4)=$P(@XMB(4),U) ;referred by - variable pointer

 S AQAODA=DA(1) D VAR,^XMB Q

 ;

 ;

REVIEW ;ENTRY POINT for reviews

 Q:X=""  Q:X'["AQAO(9"  ;not referred to a person

 S XMB(4)=$P(^AQAOC(DA(1),"REV",DA,0),U,2)

 S XMB(4)=U_$P(XMB(4),";",2)_+XMB(4)_",0)"

 S XMB(4)=$P(@XMB(4),U) ;referred by

 S AQAODA=DA(1) D VAR,^XMB Q

 ;

 ;

REVADD ;ENTRY POINT for additional referrals on reviews

 Q:X=""  Q:X'["AQAO(9"  ;not referred to a person

 S XMB(4)=$P(^AQAOC(DA(2),"REV",DA(1),0),U,2)

 S XMB(4)=U_$P(XMB(4),";",2)_+XMB(4)_",0)"

 S XMB(4)=$P(@XMB(4),U) ;referred by

 S AQAODA=DA(2) D VAR,^XMB Q

 ;

 ;

VAR ; >> gather common variables

 S XMY(+X)="" ;referred to

 S XMB(1)=$P(^AQAOC(AQAODA,0),U) ;case id

 S XMB(2)=$P(^AQAOC(AQAODA,0),U,4)

 S XMB(2)=$E(XMB(2),4,5)_"/"_$E(XMB(2),6,7)_"/"_$E(XMB(2),2,3) ;occ date

 S XMB(3)=$P(^AQAOC(AQAODA,0),U,8)

 S XMB(3)=$P(^AQAO(2,XMB(3),0),U)_"  "_$P(^(0),U,2) ;indicator # & name

 S XMB(5)=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) ;today's date

 S XMB="AQAO OCC REFERRAL",XMBDUZ="QAI_MGT_SYSTEM"

 Q

AQAOBUL   ; IHS/ORDC/LJF - BULLETIN ON PERSONAL REFERRAL ;

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

 +2       ;

 +3       ;This rtn contains 4 entry points called by MUMPS xrefs to send

 +4       ;bulletins to persons to whom an occurrence case has been referred.

 +5       ;Called by the 4 referred to fields.

 +6       ;

INITIAL   ;ENTRY POINT for initial review

 +1       ;not referred to a person

           IF X=""

               QUIT 

           IF X'["AQAO(9"

               QUIT 

 +2        SET XMB(4)=$PIECE(^AQAOC(DA,1),U,4)

 +3        SET XMB(4)=U_$PIECE(XMB(4),";",2)_+XMB(4)_",0)"

 +4       ;referred by - variable pointer

           SET XMB(4)=$PIECE(@XMB(4),U)

 +5        SET AQAODA=DA

           DO VAR

           DO ^XMB

           QUIT 

 +6       ;

 +7       ;

ADDREV    ;ENTRY POINT for additional referrals on initial review

 +1       ;not referred to a person

           IF X=""

               QUIT 

           IF X'["AQAO(9"

               QUIT 

 +2        SET XMB(4)=$PIECE(^AQAOC(DA(1),1),U,4)

 +3        SET XMB(4)=U_$PIECE(XMB(4),";",2)_+XMB(4)_",0)"

 +4       ;referred by - variable pointer

           SET XMB(4)=$PIECE(@XMB(4),U)

 +5        SET AQAODA=DA(1)

           DO VAR

           DO ^XMB

           QUIT 

 +6       ;

 +7       ;

REVIEW    ;ENTRY POINT for reviews

 +1       ;not referred to a person

           IF X=""

               QUIT 

           IF X'["AQAO(9"

               QUIT 

 +2        SET XMB(4)=$PIECE(^AQAOC(DA(1),"REV",DA,0),U,2)

 +3        SET XMB(4)=U_$PIECE(XMB(4),";",2)_+XMB(4)_",0)"

 +4       ;referred by

           SET XMB(4)=$PIECE(@XMB(4),U)

 +5        SET AQAODA=DA(1)

           DO VAR

           DO ^XMB

           QUIT 

 +6       ;

 +7       ;

REVADD    ;ENTRY POINT for additional referrals on reviews

 +1       ;not referred to a person

           IF X=""

               QUIT 

           IF X'["AQAO(9"

               QUIT 

 +2        SET XMB(4)=$PIECE(^AQAOC(DA(2),"REV",DA(1),0),U,2)

 +3        SET XMB(4)=U_$PIECE(XMB(4),";",2)_+XMB(4)_",0)"

 +4       ;referred by

           SET XMB(4)=$PIECE(@XMB(4),U)

 +5        SET AQAODA=DA(2)

           DO VAR

           DO ^XMB

           QUIT 

 +6       ;

 +7       ;

VAR       ; >> gather common variables

 +1       ;referred to

           SET XMY(+X)=""

 +2       ;case id

           SET XMB(1)=$PIECE(^AQAOC(AQAODA,0),U)

 +3        SET XMB(2)=$PIECE(^AQAOC(AQAODA,0),U,4)

 +4       ;occ date

           SET XMB(2)=$EXTRACT(XMB(2),4,5)_"/"_$EXTRACT(XMB(2),6,7)_"/"_$EXTRACT(XMB(2),2,3)

 +5        SET XMB(3)=$PIECE(^AQAOC(AQAODA,0),U,8)

 +6       ;indicator # & name

           SET XMB(3)=$PIECE(^AQAO(2,XMB(3),0),U)_"  "_$PIECE(^(0),U,2)

 +7       ;today's date

           SET XMB(5)=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)

 +8        SET XMB="AQAO OCC REFERRAL"

           SET XMBDUZ="QAI_MGT_SYSTEM"

 +9        QUIT