- PSXACT ;BIR/WPB/HTW-Activate/Inactive Processing by Host ;02 Aug 2001 11:02AM
- ;;2.0;CMOP;**1,24,27,38**;11 Apr 97
- ;Reference to File #200 supported by DBIA 10060
- EXIT S XMZ=$G(TXMZ),XMSER="S.PSXX CMOP SERVER" D:$G(XMZ)>0 REMSBMSG^XMA1C S ZTREQ="@"
- K %H,Y,DTE,SITE,RTNDOM,CMOP,REQ,XMSUB,XMZ,XMRG,LCNT,XMDUZ,XMDUN,XQA,XQAMSG,XQAROU,RDOM,RDTTM,TXMZ,XMFROM,XMRG,XMSER,XMY,XMZ,XQMSG,XQSOP,ACTFLAG,ACTION,%,DIRUT,MFLAG,OLD,RDTM,REQT,SITEN,SITENUM,XQADATA,XQAID,XQAKILL,RT
- Q
- EN ;called by taskman to activate a medical center at the cmop facility
- D NOW^%DTC S RDTTM=% K %
- S NOACT=0,SITE=$P(XMRG,U,2),CMOP=$P(XMRG,U,4),OLD=$P(XMRG,U,3),SITEN=$P(XMRG,U,5),TXMZ=XMZ,ZTREQ="@"
- S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITENUM=$$IEN^XUMF(4,AGNCY,X) K X,AGNCY ;****DOD L1
- I $G(XMFROM)["@" S RDOM=$P($G(XMFROM),"@",2),REQ=$P($G(XMFROM),"@",1)
- S:$G(XMFROM)'["@" REQ=XMFROM,RDOM="BAB.ISC-BIRM.DOMAIN.EXT"
- S RT=$P(XMRG,"^",6),REQT=$P(RT,",",2)_" "_$P(RT,",",1)
- S NAME=$$GET1^DIQ(200,DUZ,.01)
- G:$G(SITENUM)'>0 NOACT
- S ACTFLAG=1 D FILE^PSXSITE S MFLAG=0
- S XMDUZ=.5,XMSUB="CMOP Activation Request, "_SITE,LCNT=5
- D XMZ^XMA2 G:XMZ<1 EN
- MMSG D NOW^%DTC S RTDTM=% S Y=RTDTM X ^DD("DD") S RDTM=Y K Y,%
- S ^XMB(3.9,XMZ,2,1,0)="Request to activate CMOP processing."
- S ^XMB(3.9,XMZ,2,2,0)=""
- S ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITE
- S ^XMB(3.9,XMZ,2,4,0)="Requester : "_REQT
- S ^XMB(3.9,XMZ,2,5,0)="Request date/time: "_$P(RDTM,":",1,2)
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
- K XMY S XMDUZ=.5 D GRP^PSXNOTE
- D ENT1^XMD
- I MFLAG=1 Q
- S XQADATA=SITE_"^"_$G(RDOM)_"^"_CMOP_"^"_REQT_"^"_OLD_"^"_RTDTM_"^"_SITENUM_"^"_XQSOP_"^"_XQMSG_"^"_SITEN,XQAMSG=SITE_" has submitted a request to activate CMOP processing.",XQAROU="ACT^PSXACT",XQAID="PSXACT"
- D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT
- G EXIT
- Q
- ACT S SITE=$P(XQADATA,U,1),CMOP=$P(XQADATA,U,3),(REQ,REQT)=$P(XQADATA,U,4),OLD=$P(XQADATA,U,5),RDTTM=$P(XQADATA,U,6),SITENUM=$P(XQADATA,U,7),RDOM=$P(XQADATA,U,2),XMSER="S."_$P(XQADATA,U,8),TXMZ=$P(XQADATA,U,9),SITEN=$P(XQADATA,U,10)
- S NAME=$$GET1^DIQ(200,DUZ,.01)
- D WORK
- S XQAKILL=0 D DELETE^XQALERT
- Q
- WORK W !!
- S DIR(0)="SO^A:APPROVED;D:DISAPPROVED",DIR("A",1)=SITE_" has submitted a request to activate CMOP processing.",DIR("A",2)="",DIR("A")="Select"
- D ^DIR K DIR S ACTION=Y G:($D(DIRUT)) EXIT K Y
- WK S:ACTION="A" ACTFLAG=1
- S:ACTION="D" ACTFLAG=0
- OK S %H=$H D YX^%DTC S DTE=Y K Y
- S XMSUB=($S(ACTION="A":"CMOP Activation Approval",ACTION="D":"CMOP Activation Disapproved",1:"")),LCNT=2
- S XMDUZ=.5 D XMZ^XMA2 G:XMZ<1 OK
- D NOW^%DTC
- S NAME=$$GET1^DIQ(200,DUZ,.01)
- S ^XMB(3.9,XMZ,2,1,0)="$$SYS^"_$S(ACTFLAG=1:"A",ACTFLAG=0:"I",1:"")_"^"_CMOP_"^"_%_"^"_NAME_"^"_OLD
- S ^XMB(3.9,XMZ,2,2,0)="$$ENDSYS"
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN=NAME
- K XMY S XMDUZ=.5,XMY($S($G(RDOM)["BAB.":"S.PSXX CMOP SERVER",$G(RDOM)'="":"S.PSXX CMOP SERVER@"_RDOM,1:""))=""
- K % D ENT1^XMD
- MSG S XMSUB=($S(ACTFLAG=1:"CMOP Activation Approval",ACTFLAG=0:"CMOP Activation Disapproved",1:"")),LCNT=6
- S XMDUZ=.5 D XMZ^XMA2 G:XMZ<1 MSG
- S NAME=$$GET1^DIQ(200,DUZ,.01)
- S ^XMB(3.9,XMZ,2,6,0)="Action taken : "_$S(ACTFLAG=1:"Approved",ACTFLAG=0:"Disapproved",1:"")
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT+1_U_LCNT+1_U_DT,XMDUN=NAME
- S MFLAG=1 D MMSG
- Q:$G(NOACT)=1
- D FILEA^PSXSITE
- Q
- ;Called by Taskman to Deactivate a Remote facility from CMOP
- DEACT S ACTFLAG=0
- D NOW^%DTC S (Y,RDTTM)=% X ^DD("DD") S RDTM=Y K Y
- S SITE=$P(XMRG,U,2),OLD=$P(XMRG,U,3),CMOP=$P(XMRG,U,4),SITEN=$P(XMRG,U,5),XMSER="S."_XQSOP,TXMZ=XQMSG
- ;S DIC="4",DIC(0)="OXMZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENUM=+Y K DIC,X,Y ;****DOD L1
- S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITENUM=$$IEN^XUMF(4,AGNCY,X) K X,AGNCY ;****DOD L1
- I $G(XMFROM)["@" S RDOM=$P($G(XMFROM),"@",2),REQ=$P($G(XMFROM),"@",1)
- S:$G(XMFROM)'["@" REQ=XMFROM,RDOM="BAB.ISC-BIRM.DOMAIN.EXT"
- S RT=$P(XMRG,"^",6),REQT=$P(RT,",",2)_" "_$P(RT,",",1)
- S NAME=$$GET1^DIQ(200,DUZ,.01)
- D FILE^PSXSITE
- S XMDUZ=.5,XMSUB="CMOP Inactivation Notice, "_SITE,LCNT=5
- DXMZ D XMZ^XMA2 G:XMZ<1 DXMZ
- S ^XMB(3.9,XMZ,2,1,0)="Notice to Inactivate CMOP Processing."
- S ^XMB(3.9,XMZ,2,2,0)=""
- S ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITE
- S ^XMB(3.9,XMZ,2,4,0)="Notifying Official : "_REQT
- S ^XMB(3.9,XMZ,2,5,0)="Notification date/time : "_$P(RDTM,":",1,2)
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
- K XMY S XMDUZ=.5 D GRP^PSXNOTE
- D ENT1^XMD
- S XMDUZ=.5,XMSUB=("CMOP Inactivation Notice"),LCNT=1
- RXMZ D XMZ^XMA2 G:XMZ<1 RXMZ
- S ^XMB(3.9,XMZ,2,1,0)="$$SYS^"_"D"_"^"_CMOP_"^"_$G(RDTTM)_"^"_NAME_"^"_OLD
- S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
- K XMY,% S XMDUZ=.5,XMY($S($G(RDOM)="":"S.PSXX CMOP SERVER",$G(RDOM)'="":"S.PSXX CMOP SERVER@"_RDOM,1:""))=""
- D ENT1^XMD
- D GRP^PSXNOTE
- S XQAMSG=SITE_" has inactivated CMOP processing." D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT
- G EXIT
- NOACT N XQA,XQAMSG
- S XQAFLG="D",ACTION="D",NOACT=1
- S XQAMSG=SITE_" Activation disapproved, bad entry in Institution File." D GRP^PSXNOTE D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT,WK
- N XMZ S XMSUB="CMOP Activation Request Disapproved",XMDUN="CMOP Manager",XMDUZ=.5
- NOMSG D XMZ^XMA2 G:XMZ<1 NOMSG
- S ^XMB(3.9,XMZ,2,1,0)=SITE_" Requested to activate, but was denied."
- S ^XMB(3.9,XMZ,2,2,0)="The request was disapproved because there are multiple entries"
- S ^XMB(3.9,XMZ,2,3,0)="in the Institution file with the same Station Number or"
- S ^XMB(3.9,XMZ,2,4,0)="there wasn't an entry in the Institution file for the Station Number."
- S ^XMB(3.9,XMZ,2,5,0)=""
- S ^XMB(3.9,XMZ,2,6,0)="Please check the Institution file for "_$G(SITE)_"."
- S ^XMB(3.9,XMZ,2,7,0)="Station Numbers are unique. There should only be one entry in the file for"
- S ^XMB(3.9,XMZ,2,8,0)="a station number."
- S ^XMB(3.9,XMZ,2,0)="^3.92A^8^8^"_DT
- K XMY D GRP^PSXNOTE D ENT1^XMD
- K XMY,XMZ,XMSUB
- G EXIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXACT 6070 printed Feb 18, 2025@23:09:41 Page 2
- PSXACT ;BIR/WPB/HTW-Activate/Inactive Processing by Host ;02 Aug 2001 11:02AM
- +1 ;;2.0;CMOP;**1,24,27,38**;11 Apr 97
- +2 ;Reference to File #200 supported by DBIA 10060
- EXIT SET XMZ=$GET(TXMZ)
- SET XMSER="S.PSXX CMOP SERVER"
- if $GET(XMZ)>0
- DO REMSBMSG^XMA1C
- SET ZTREQ="@"
- +1 KILL %H,Y,DTE,SITE,RTNDOM,CMOP,REQ,XMSUB,XMZ,XMRG,LCNT,XMDUZ,XMDUN,XQA,XQAMSG,XQAROU,RDOM,RDTTM,TXMZ,XMFROM,XMRG,XMSER,XMY,XMZ,XQMSG,XQSOP,ACTFLAG,ACTION,%,DIRUT,MFLAG,OLD,RDTM,REQT,SITEN,SITENUM,XQADATA,XQAID,XQAKILL,RT
- +2 QUIT
- EN ;called by taskman to activate a medical center at the cmop facility
- +1 DO NOW^%DTC
- SET RDTTM=%
- KILL %
- +2 SET NOACT=0
- SET SITE=$PIECE(XMRG,U,2)
- SET CMOP=$PIECE(XMRG,U,4)
- SET OLD=$PIECE(XMRG,U,3)
- SET SITEN=$PIECE(XMRG,U,5)
- SET TXMZ=XMZ
- SET ZTREQ="@"
- +3 ;****DOD L1
- SET X=SITEN
- SET AGNCY="VASTANUM"
- if $DATA(^PSX(552,"D",X))
- SET X=$EXTRACT(X,2,99)
- SET AGNCY="DMIS"
- SET SITENUM=$$IEN^XUMF(4,AGNCY,X)
- KILL X,AGNCY
- +4 IF $GET(XMFROM)["@"
- SET RDOM=$PIECE($GET(XMFROM),"@",2)
- SET REQ=$PIECE($GET(XMFROM),"@",1)
- +5 if $GET(XMFROM)'["@"
- SET REQ=XMFROM
- SET RDOM="BAB.ISC-BIRM.DOMAIN.EXT"
- +6 SET RT=$PIECE(XMRG,"^",6)
- SET REQT=$PIECE(RT,",",2)_" "_$PIECE(RT,",",1)
- +7 SET NAME=$$GET1^DIQ(200,DUZ,.01)
- +8 if $GET(SITENUM)'>0
- GOTO NOACT
- +9 SET ACTFLAG=1
- DO FILE^PSXSITE
- SET MFLAG=0
- +10 SET XMDUZ=.5
- SET XMSUB="CMOP Activation Request, "_SITE
- SET LCNT=5
- +11 DO XMZ^XMA2
- if XMZ<1
- GOTO EN
- MMSG DO NOW^%DTC
- SET RTDTM=%
- SET Y=RTDTM
- XECUTE ^DD("DD")
- SET RDTM=Y
- KILL Y,%
- +1 SET ^XMB(3.9,XMZ,2,1,0)="Request to activate CMOP processing."
- +2 SET ^XMB(3.9,XMZ,2,2,0)=""
- +3 SET ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITE
- +4 SET ^XMB(3.9,XMZ,2,4,0)="Requester : "_REQT
- +5 SET ^XMB(3.9,XMZ,2,5,0)="Request date/time: "_$PIECE(RDTM,":",1,2)
- +6 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
- SET XMDUN=NAME
- +7 KILL XMY
- SET XMDUZ=.5
- DO GRP^PSXNOTE
- +8 DO ENT1^XMD
- +9 IF MFLAG=1
- QUIT
- +10 SET XQADATA=SITE_"^"_$GET(RDOM)_"^"_CMOP_"^"_REQT_"^"_OLD_"^"_RTDTM_"^"_SITENUM_"^"_XQSOP_"^"_XQMSG_"^"_SITEN
- SET XQAMSG=SITE_" has submitted a request to activate CMOP processing."
- SET XQAROU="ACT^PSXACT"
- SET XQAID="PSXACT"
- +11 DO GRP1^PSXNOTE
- MERGE XQA=XMY
- DO SETUP^XQALERT
- +12 GOTO EXIT
- +13 QUIT
- ACT SET SITE=$PIECE(XQADATA,U,1)
- SET CMOP=$PIECE(XQADATA,U,3)
- SET (REQ,REQT)=$PIECE(XQADATA,U,4)
- SET OLD=$PIECE(XQADATA,U,5)
- SET RDTTM=$PIECE(XQADATA,U,6)
- SET SITENUM=$PIECE(XQADATA,U,7)
- SET RDOM=$PIECE(XQADATA,U,2)
- SET XMSER="S."_$PIECE(XQADATA,U,8)
- SET TXMZ=$PIECE(XQADATA,U,9)
- SET SITEN=$PIECE(XQADATA,U,10)
- +1 SET NAME=$$GET1^DIQ(200,DUZ,.01)
- +2 DO WORK
- +3 SET XQAKILL=0
- DO DELETE^XQALERT
- +4 QUIT
- WORK WRITE !!
- +1 SET DIR(0)="SO^A:APPROVED;D:DISAPPROVED"
- SET DIR("A",1)=SITE_" has submitted a request to activate CMOP processing."
- SET DIR("A",2)=""
- SET DIR("A")="Select"
- +2 DO ^DIR
- KILL DIR
- SET ACTION=Y
- if ($DATA(DIRUT))
- GOTO EXIT
- KILL Y
- WK if ACTION="A"
- SET ACTFLAG=1
- +1 if ACTION="D"
- SET ACTFLAG=0
- OK SET %H=$HOROLOG
- DO YX^%DTC
- SET DTE=Y
- KILL Y
- +1 SET XMSUB=($SELECT(ACTION="A":"CMOP Activation Approval",ACTION="D":"CMOP Activation Disapproved",1:""))
- SET LCNT=2
- +2 SET XMDUZ=.5
- DO XMZ^XMA2
- if XMZ<1
- GOTO OK
- +3 DO NOW^%DTC
- +4 SET NAME=$$GET1^DIQ(200,DUZ,.01)
- +5 SET ^XMB(3.9,XMZ,2,1,0)="$$SYS^"_$SELECT(ACTFLAG=1:"A",ACTFLAG=0:"I",1:"")_"^"_CMOP_"^"_%_"^"_NAME_"^"_OLD
- +6 SET ^XMB(3.9,XMZ,2,2,0)="$$ENDSYS"
- +7 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT
- SET XMDUN=NAME
- +8 KILL XMY
- SET XMDUZ=.5
- SET XMY($SELECT($GET(RDOM)["BAB.":"S.PSXX CMOP SERVER",$GET(RDOM)'="":"S.PSXX CMOP SERVER@"_RDOM,1:""))=""
- +9 KILL %
- DO ENT1^XMD
- MSG SET XMSUB=($SELECT(ACTFLAG=1:"CMOP Activation Approval",ACTFLAG=0:"CMOP Activation Disapproved",1:""))
- SET LCNT=6
- +1 SET XMDUZ=.5
- DO XMZ^XMA2
- if XMZ<1
- GOTO MSG
- +2 SET NAME=$$GET1^DIQ(200,DUZ,.01)
- +3 SET ^XMB(3.9,XMZ,2,6,0)="Action taken : "_$SELECT(ACTFLAG=1:"Approved",ACTFLAG=0:"Disapproved",1:"")
- +4 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT+1_U_LCNT+1_U_DT
- SET XMDUN=NAME
- +5 SET MFLAG=1
- DO MMSG
- +6 if $GET(NOACT)=1
- QUIT
- +7 DO FILEA^PSXSITE
- +8 QUIT
- +9 ;Called by Taskman to Deactivate a Remote facility from CMOP
- DEACT SET ACTFLAG=0
- +1 DO NOW^%DTC
- SET (Y,RDTTM)=%
- XECUTE ^DD("DD")
- SET RDTM=Y
- KILL Y
- +2 SET SITE=$PIECE(XMRG,U,2)
- SET OLD=$PIECE(XMRG,U,3)
- SET CMOP=$PIECE(XMRG,U,4)
- SET SITEN=$PIECE(XMRG,U,5)
- SET XMSER="S."_XQSOP
- SET TXMZ=XQMSG
- +3 ;S DIC="4",DIC(0)="OXMZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENUM=+Y K DIC,X,Y ;****DOD L1
- +4 ;****DOD L1
- SET X=SITEN
- SET AGNCY="VASTANUM"
- if $DATA(^PSX(552,"D",X))
- SET X=$EXTRACT(X,2,99)
- SET AGNCY="DMIS"
- SET SITENUM=$$IEN^XUMF(4,AGNCY,X)
- KILL X,AGNCY
- +5 IF $GET(XMFROM)["@"
- SET RDOM=$PIECE($GET(XMFROM),"@",2)
- SET REQ=$PIECE($GET(XMFROM),"@",1)
- +6 if $GET(XMFROM)'["@"
- SET REQ=XMFROM
- SET RDOM="BAB.ISC-BIRM.DOMAIN.EXT"
- +7 SET RT=$PIECE(XMRG,"^",6)
- SET REQT=$PIECE(RT,",",2)_" "_$PIECE(RT,",",1)
- +8 SET NAME=$$GET1^DIQ(200,DUZ,.01)
- +9 DO FILE^PSXSITE
- +10 SET XMDUZ=.5
- SET XMSUB="CMOP Inactivation Notice, "_SITE
- SET LCNT=5
- DXMZ DO XMZ^XMA2
- if XMZ<1
- GOTO DXMZ
- +1 SET ^XMB(3.9,XMZ,2,1,0)="Notice to Inactivate CMOP Processing."
- +2 SET ^XMB(3.9,XMZ,2,2,0)=""
- +3 SET ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITE
- +4 SET ^XMB(3.9,XMZ,2,4,0)="Notifying Official : "_REQT
- +5 SET ^XMB(3.9,XMZ,2,5,0)="Notification date/time : "_$PIECE(RDTM,":",1,2)
- +6 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
- SET XMDUN=NAME
- +7 KILL XMY
- SET XMDUZ=.5
- DO GRP^PSXNOTE
- +8 DO ENT1^XMD
- +9 SET XMDUZ=.5
- SET XMSUB=("CMOP Inactivation Notice")
- SET LCNT=1
- RXMZ DO XMZ^XMA2
- if XMZ<1
- GOTO RXMZ
- +1 SET ^XMB(3.9,XMZ,2,1,0)="$$SYS^"_"D"_"^"_CMOP_"^"_$GET(RDTTM)_"^"_NAME_"^"_OLD
- +2 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
- SET XMDUN=NAME
- +3 KILL XMY,%
- SET XMDUZ=.5
- SET XMY($SELECT($GET(RDOM)="":"S.PSXX CMOP SERVER",$GET(RDOM)'="":"S.PSXX CMOP SERVER@"_RDOM,1:""))=""
- +4 DO ENT1^XMD
- +5 DO GRP^PSXNOTE
- +6 SET XQAMSG=SITE_" has inactivated CMOP processing."
- DO GRP1^PSXNOTE
- MERGE XQA=XMY
- DO SETUP^XQALERT
- +7 GOTO EXIT
- NOACT NEW XQA,XQAMSG
- +1 SET XQAFLG="D"
- SET ACTION="D"
- SET NOACT=1
- +2 SET XQAMSG=SITE_" Activation disapproved, bad entry in Institution File."
- DO GRP^PSXNOTE
- DO GRP1^PSXNOTE
- MERGE XQA=XMY
- DO SETUP^XQALERT
- DO WK
- +3 NEW XMZ
- SET XMSUB="CMOP Activation Request Disapproved"
- SET XMDUN="CMOP Manager"
- SET XMDUZ=.5
- NOMSG DO XMZ^XMA2
- if XMZ<1
- GOTO NOMSG
- +1 SET ^XMB(3.9,XMZ,2,1,0)=SITE_" Requested to activate, but was denied."
- +2 SET ^XMB(3.9,XMZ,2,2,0)="The request was disapproved because there are multiple entries"
- +3 SET ^XMB(3.9,XMZ,2,3,0)="in the Institution file with the same Station Number or"
- +4 SET ^XMB(3.9,XMZ,2,4,0)="there wasn't an entry in the Institution file for the Station Number."
- +5 SET ^XMB(3.9,XMZ,2,5,0)=""
- +6 SET ^XMB(3.9,XMZ,2,6,0)="Please check the Institution file for "_$GET(SITE)_"."
- +7 SET ^XMB(3.9,XMZ,2,7,0)="Station Numbers are unique. There should only be one entry in the file for"
- +8 SET ^XMB(3.9,XMZ,2,8,0)="a station number."
- +9 SET ^XMB(3.9,XMZ,2,0)="^3.92A^8^8^"_DT
- +10 KILL XMY
- DO GRP^PSXNOTE
- DO ENT1^XMD
- +11 KILL XMY,XMZ,XMSUB
- +12 GOTO EXIT