- 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
