- AFSLTT1 ;IHS/OIRM/DSD/HJT - EXPORT PAYMENT RCDS TO FILE-MODULE #2; [ 09/27/2005 1:32 PM ]
- ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
- ;Reviewed for Y2k Compliance. See comment at tag PDT
- ;Generate unix file for convey of pmts to Treasury - part 2
- U IO(0)
- D ^XBCLS U IO(0) W "Processing..."
- S (AFSL1,AFSLEMSG,AFSLFLG1,AFSL1A,AFSL2,AFSL3,AFSL4,AFSL5,AFSLSCH1,AFSLFYN,AFSLSEQ,AFSLSEQ1,AFSLCNT,AFSLAMT,AFSLIN)=0 S AFSLPG=1
- S AFSLFY=AFSLTFY
- PRC ;loop thru payment type x-ref's
- S AFSLFYN="",AFSLFYN=$O(^AFSLAFP("B",AFSLFY,AFSLFYN))
- S (AFSLEIN,AFSLEIN1)="",(AFSLCBC,AFSLFLG,AFSLCBA,AFSLCNT)=0,AFSLCNT1=1
- TREAS S AFSLBN=$P(^AFSLAFP(AFSLFYN,2),U,1)+1
- S DIR(0)="F^6:6"
- S DIR("B")=AFSLBN
- S DIR("A")="TREASURY SCHEDULE NUMBER:"
- S DIR("?")="Enter six characters"
- S DIR("??")="AFSL TREASURY"
- D ^DIR S AFSLBN=Y
- S AFSLSCDX="0000"_X
- I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) U IO(0) W !!,"NO ""^"" ALLOWED" H 2 G TREAS
- S DIE="^AFSLAFP(",DA=AFSLFYN,DR="2///"_AFSLBN D ^DIE
- S AFSLSH11="0000"_$P(^AFSLAFP(AFSLFYN,2),U,1)
- D HDR^AFSLTT2
- F AFSLX="E","G","H" D XREF
- D EXDAT
- I AFSLEMSG=0,AFSLFLG=1 D TRL^AFSLTT2,FRD^AFSLTT3 Q
- ;E S AFSLEFLG=1
- S AFSLEFLG=1
- Q
- XREF ;
- F J=0:0 S AFSLEIN=$O(^AFSLAFP(AFSLX,AFSLEIN)) Q:(AFSLEIN="")!(AFSLEMSG=1) I $D(^AFSLAFP(AFSLX,AFSLEIN,AFSLFYN)) D SEIN0
- Q
- SEIN0 ;
- S AFSLSCH1="" F I=1:1 S AFSLSCH1=$O(^AFSLAFP(AFSLX,AFSLEIN,AFSLFYN,AFSLSCH1)) D:AFSLSCH1="" GSET Q:(AFSLSCH1="")!(AFSLEMSG=1) D CHK D:AFSLFLG1 SEIN1 S AFSLFLG1=0
- Q
- SEIN1 ;
- I '$D(^AFSLAFP("M",AFSLBN,AFSLFYN,AFSLSCH1)) D TNUM
- S AFSLEIN1="" F L=0:0 S AFSLEIN1=$O(^AFSLAFP(AFSLX,AFSLEIN,AFSLFYN,AFSLSCH1,AFSLEIN1)) Q:(AFSLEIN1="")!(AFSLEMSG=1) D DCHK^AFSLTT2 Q:AFSLEMSG=1 D SEIN2
- Q
- EXDAT ;set export date for schedule
- S AFSLSC12="" F V=0:0 S AFSLSC12=$O(AFSLSCH1(AFSLSC12)) Q:AFSLSC12="" S DIE="^AFSLAFP("_AFSLFYN_",1,",DA(1)=AFSLFYN,DA=AFSLSC12,DR="5///TODAY" D ^DIE L -^AFSLAFP ;UNLOCK THE 1166 PAYMENTS FILE
- Q
- SEIN2 ;
- Q:('$D(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,0)))!($P(^(0),U,27)["D") S AFSLTT=^(0)
- S:$D(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1)) AFSLTT5=^(1),AFSLVEIX=$P(^(1),U,22)
- S X=$P(AFSLTT,U,11)
- I $D(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1)) S AFSLTT=AFSLTT_$P(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1),U,21)
- ;ABOVE AFSLVEIX... ADDED TO LOOKUP VENDOR
- S X2="2",X3=10
- D COMMA^%DTC
- S AFSLTT9=$E(X,1,9)
- S AFSLTT9=$J(AFSLTT9,10)
- D PDT
- S AFSLCBC=AFSLCBC+1,AFSLCBA=AFSLCBA+$P(AFSLTT,U,11)
- D GSET1
- Q
- GSET1 ; line item payment data
- S AFSLTT1A=$S(AFSLX="E":$P(AFSLTT,U,10),1:$P(AFSLTT,U,24))
- I '$D(AFSLVEIX) S AFSLVEIX=""
- I $L(AFSLVEIX)=10!($L(AFSLVEIX)=12) S AFSLPID=$E(AFSLVEIX,1,10),AFSLPSFX="" S:$L(AFSLVEIX)=12 AFSLPSFX=$E(AFSLVEIX,11,12) D ^AFSLVILU S:Y>0 AFSLTT1A=$P(Y,U,1) ; ADDED TO LOOKUP VENDOR EIN
- S AFSLTT2=$S(AFSLX="E":$P(^AUTTVNDR(AFSLTT1A,11),U,13),1:$P(^VA(200,AFSLTT1A,1),U,9))
- S AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0)=$P(AFSLTT,U,20)_" "_"$"_AFSLTT9_" "_$P(AFSLTT,U,14) S AFSLLG=$L(AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0)),AFSLLG=55-AFSLLG
- S AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0)=AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0)_$J("",AFSLLG)
- I AFSLX["E" S AFSLCBAV=-$P(AFSLTT,U,11),AFSLCBAV=$P(^AUTTVNDR(AFSLTT1A,0),U,10)-AFSLCBAV S DIE=9999999.11,DA=AFSLTT1A,DR="1107///^S X=AFSLCBAV" D ^DIE
- ;D:AFSLCBC=12 GSET
- D GSET
- Q
- GSET ; record total data
- Q:AFSLCBC=0
- S AFSLCBA=AFSLCBA*100,AFSLCBA=$E(AFSLOO,1,8-$L(AFSLCBA))_AFSLCBA,AFSLCBA=$J(AFSLCBA,8)
- S AFSLTT(AFSLTT2,AFSLCNT1,0)=AFSLSH11_"2"
- S AFSLTT(AFSLTT2,AFSLCNT1,0)=AFSLTT(AFSLTT2,AFSLCNT1,0)_AFSLTT2_$J("",12-$L(AFSLTT2))_"0"_AFSLCBA_"IHS"_$J("",7)_"B"
- ;S AFSLTT4=$S(AFSLX="E":$P(^AUTTVNDR(AFSLTT1A,0),U,1),1:$P(^VA(200,AFSLTT1A,0),U,1)),AFSLTT4=AFSLTT4_$J("",35-$L(AFSLTT4)),AFSLTT4=$E(AFSLTT4,1,35) ;ACR*2.1*19.02 IM16848
- S AFSLTT4=$S(AFSLX="E":$P(^AUTTVNDR(AFSLTT1A,0),U,1),1:$$NAME2^ACRFUTL1(AFSLTT1A)) ;ACR*2.1*19.02 IM16848
- S AFSLTT4=AFSLTT4_$J("",35-$L(AFSLTT4)) ;ACR*2.1*19.02 IM16848
- S AFSLTT4=$E(AFSLTT4,1,35) ;ACR*2.1*19.02 IM16848
- S AFSLTT(AFSLTT2,AFSLCNT1,0)=AFSLTT(AFSLTT2,AFSLCNT1,0)_AFSLTT4
- I AFSLX["E" D VADR^AFSLTT4
- I AFSLX'["E" D EADR^AFSLTT4
- S AFSLTT(AFSLTT2,AFSLCNT1,2)=AFSLTT(AFSLTT2,AFSLCNT1,2)_$J("",67)_$S(AFSLCBC<10:"0"_AFSLCBC,1:AFSLCBC)
- S AFSLCNT=AFSLCNT+1,AFSLAMT=AFSLAMT+AFSLCBA,AFSLCBC=0,AFSLCBA=0
- D PRC^AFSLTT2 K AFSLTT S AFSLCNT1=AFSLCNT1+1
- Q
- CHK ;checks for certification date,open/close,export date
- I $D(^AFSLAFP(AFSLFYN,1,AFSLSCH1,0)) S AFSLSCH3=^(0)
- E Q
- I $D(^AFSLAFP(AFSLFYN,1,AFSLSCH1,2)) S AFSLSCH2=^(2)
- E Q
- I '$D(^AFSLAFP("ME",AFSLFYN,$P(^AFSLAFP(AFSLFYN,1,AFSLSCH1,0),U,1))) Q
- I $P(AFSLSCH3,U,5)]"",$P(AFSLSCH2,U,1)']"",$P(AFSLSCH2,U,3)["C",$P(AFSLSCH2,U,2)'>DT-7 S AFSLFLG=1,AFSLFLG1=1,AFSLSCH=$P(AFSLSCH3,U,1),AFSLSCH1(AFSLSCH1)=AFSLSCH1
- S AFSLOO="0000000000"
- Q
- TNUM ;
- S X=AFSLBN
- S DIE="^AFSLAFP("_AFSLFYN_",1,"
- S DA(1)=AFSLFYN
- S DA=AFSLSCH1
- S DR="10////"_AFSLSH11
- D ^DIE
- Q
- PDT ;
- ;The variable AFSLPDT should be in a fileman format by the time it
- ; is set into these files here. It was set in AFSLRTT1, AFSLRTTX,
- ; AFSLEXM1 & AFSLSAV2. No change made here. Should be Y2k compliant.
- S DIE="^AFSLAFP("_AFSLFYN_",1,"_AFSLSCH1_",1,",DA(2)=AFSLFYN
- S DA(1)=AFSLSCH1,DA=AFSLEIN1,DR="19////"_AFSLPDT
- D ^DIE
- S AFSLDNUM=$P(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1),U,16),AFSLDFYN=$P(^(1),U,15),AFSLPDNM=$P(^(1),U,7)
- S DIE="^AFSLODOC("_AFSLDFYN_",1,"_AFSLDNUM_",1,"
- S DA(2)=AFSLDFYN
- S DA(1)=AFSLDNUM
- S DA=AFSLPDNM
- S DR="1////"_AFSLPDT
- D ^DIE
- Q
- AFSLTT1 ;IHS/OIRM/DSD/HJT - EXPORT PAYMENT RCDS TO FILE-MODULE #2; [ 09/27/2005 1:32 PM ]
- +1 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
- +2 ;Reviewed for Y2k Compliance. See comment at tag PDT
- +3 ;Generate unix file for convey of pmts to Treasury - part 2
- +4 USE IO(0)
- +5 DO ^XBCLS
- USE IO(0)
- WRITE "Processing..."
- +6 SET (AFSL1,AFSLEMSG,AFSLFLG1,AFSL1A,AFSL2,AFSL3,AFSL4,AFSL5,AFSLSCH1,AFSLFYN,AFSLSEQ,AFSLSEQ1,AFSLCNT,AFSLAMT,AFSLIN)=0
- SET AFSLPG=1
- +7 SET AFSLFY=AFSLTFY
- PRC ;loop thru payment type x-ref's
- +1 SET AFSLFYN=""
- SET AFSLFYN=$ORDER(^AFSLAFP("B",AFSLFY,AFSLFYN))
- +2 SET (AFSLEIN,AFSLEIN1)=""
- SET (AFSLCBC,AFSLFLG,AFSLCBA,AFSLCNT)=0
- SET AFSLCNT1=1
- TREAS SET AFSLBN=$PIECE(^AFSLAFP(AFSLFYN,2),U,1)+1
- +1 SET DIR(0)="F^6:6"
- +2 SET DIR("B")=AFSLBN
- +3 SET DIR("A")="TREASURY SCHEDULE NUMBER:"
- +4 SET DIR("?")="Enter six characters"
- +5 SET DIR("??")="AFSL TREASURY"
- +6 DO ^DIR
- SET AFSLBN=Y
- +7 SET AFSLSCDX="0000"_X
- +8 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
- USE IO(0)
- WRITE !!,"NO ""^"" ALLOWED"
- HANG 2
- GOTO TREAS
- +9 SET DIE="^AFSLAFP("
- SET DA=AFSLFYN
- SET DR="2///"_AFSLBN
- DO ^DIE
- +10 SET AFSLSH11="0000"_$PIECE(^AFSLAFP(AFSLFYN,2),U,1)
- +11 DO HDR^AFSLTT2
- +12 FOR AFSLX="E","G","H"
- DO XREF
- +13 DO EXDAT
- +14 IF AFSLEMSG=0
- IF AFSLFLG=1
- DO TRL^AFSLTT2
- DO FRD^AFSLTT3
- QUIT
- +15 ;E S AFSLEFLG=1
- +16 SET AFSLEFLG=1
- +17 QUIT
- XREF ;
- +1 FOR J=0:0
- SET AFSLEIN=$ORDER(^AFSLAFP(AFSLX,AFSLEIN))
- IF (AFSLEIN="")!(AFSLEMSG=1)
- QUIT
- IF $DATA(^AFSLAFP(AFSLX,AFSLEIN,AFSLFYN))
- DO SEIN0
- +2 QUIT
- SEIN0 ;
- +1 SET AFSLSCH1=""
- FOR I=1:1
- SET AFSLSCH1=$ORDER(^AFSLAFP(AFSLX,AFSLEIN,AFSLFYN,AFSLSCH1))
- IF AFSLSCH1=""
- DO GSET
- IF (AFSLSCH1="")!(AFSLEMSG=1)
- QUIT
- DO CHK
- IF AFSLFLG1
- DO SEIN1
- SET AFSLFLG1=0
- +2 QUIT
- SEIN1 ;
- +1 IF '$DATA(^AFSLAFP("M",AFSLBN,AFSLFYN,AFSLSCH1))
- DO TNUM
- +2 SET AFSLEIN1=""
- FOR L=0:0
- SET AFSLEIN1=$ORDER(^AFSLAFP(AFSLX,AFSLEIN,AFSLFYN,AFSLSCH1,AFSLEIN1))
- IF (AFSLEIN1="")!(AFSLEMSG=1)
- QUIT
- DO DCHK^AFSLTT2
- IF AFSLEMSG=1
- QUIT
- DO SEIN2
- +3 QUIT
- EXDAT ;set export date for schedule
- +1 ;UNLOCK THE 1166 PAYMENTS FILE
- SET AFSLSC12=""
- FOR V=0:0
- SET AFSLSC12=$ORDER(AFSLSCH1(AFSLSC12))
- IF AFSLSC12=""
- QUIT
- SET DIE="^AFSLAFP("_AFSLFYN_",1,"
- SET DA(1)=AFSLFYN
- SET DA=AFSLSC12
- SET DR="5///TODAY"
- DO ^DIE
- LOCK -^AFSLAFP
- +2 QUIT
- SEIN2 ;
- +1 IF ('$DATA(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,0)))!($PIECE(^(0),U,27)["D")
- QUIT
- SET AFSLTT=^(0)
- +2 IF $DATA(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1))
- SET AFSLTT5=^(1)
- SET AFSLVEIX=$PIECE(^(1),U,22)
- +3 SET X=$PIECE(AFSLTT,U,11)
- +4 IF $DATA(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1))
- SET AFSLTT=AFSLTT_$PIECE(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1),U,21)
- +5 ;ABOVE AFSLVEIX... ADDED TO LOOKUP VENDOR
- +6 SET X2="2"
- SET X3=10
- +7 DO COMMA^%DTC
- +8 SET AFSLTT9=$EXTRACT(X,1,9)
- +9 SET AFSLTT9=$JUSTIFY(AFSLTT9,10)
- +10 DO PDT
- +11 SET AFSLCBC=AFSLCBC+1
- SET AFSLCBA=AFSLCBA+$PIECE(AFSLTT,U,11)
- +12 DO GSET1
- +13 QUIT
- GSET1 ; line item payment data
- +1 SET AFSLTT1A=$SELECT(AFSLX="E":$PIECE(AFSLTT,U,10),1:$PIECE(AFSLTT,U,24))
- +2 IF '$DATA(AFSLVEIX)
- SET AFSLVEIX=""
- +3 ; ADDED TO LOOKUP VENDOR EIN
- IF $LENGTH(AFSLVEIX)=10!($LENGTH(AFSLVEIX)=12)
- SET AFSLPID=$EXTRACT(AFSLVEIX,1,10)
- SET AFSLPSFX=""
- IF $LENGTH(AFSLVEIX)=12
- SET AFSLPSFX=$EXTRACT(AFSLVEIX,11,12)
- DO ^AFSLVILU
- IF Y>0
- SET AFSLTT1A=$PIECE(Y,U,1)
- +4 SET AFSLTT2=$SELECT(AFSLX="E":$PIECE(^AUTTVNDR(AFSLTT1A,11),U,13),1:$PIECE(^VA(200,AFSLTT1A,1),U,9))
- +5 SET AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0)=$PIECE(AFSLTT,U,20)_" "_"$"_AFSLTT9_" "_$PIECE(AFSLTT,U,14)
- SET AFSLLG=$LENGTH(AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0))
- SET AFSLLG=55-AFSLLG
- +6 SET AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0)=AFSLTT(AFSLTT2,AFSLCNT1,3,AFSLCBC,0)_$JUSTIFY("",AFSLLG)
- +7 IF AFSLX["E"
- SET AFSLCBAV=-$PIECE(AFSLTT,U,11)
- SET AFSLCBAV=$PIECE(^AUTTVNDR(AFSLTT1A,0),U,10)-AFSLCBAV
- SET DIE=9999999.11
- SET DA=AFSLTT1A
- SET DR="1107///^S X=AFSLCBAV"
- DO ^DIE
- +8 ;D:AFSLCBC=12 GSET
- +9 DO GSET
- +10 QUIT
- GSET ; record total data
- +1 IF AFSLCBC=0
- QUIT
- +2 SET AFSLCBA=AFSLCBA*100
- SET AFSLCBA=$EXTRACT(AFSLOO,1,8-$LENGTH(AFSLCBA))_AFSLCBA
- SET AFSLCBA=$JUSTIFY(AFSLCBA,8)
- +3 SET AFSLTT(AFSLTT2,AFSLCNT1,0)=AFSLSH11_"2"
- +4 SET AFSLTT(AFSLTT2,AFSLCNT1,0)=AFSLTT(AFSLTT2,AFSLCNT1,0)_AFSLTT2_$JUSTIFY("",12-$LENGTH(AFSLTT2))_"0"_AFSLCBA_"IHS"_$JUSTIFY("",7)_"B"
- +5 ;S AFSLTT4=$S(AFSLX="E":$P(^AUTTVNDR(AFSLTT1A,0),U,1),1:$P(^VA(200,AFSLTT1A,0),U,1)),AFSLTT4=AFSLTT4_$J("",35-$L(AFSLTT4)),AFSLTT4=$E(AFSLTT4,1,35) ;ACR*2.1*19.02 IM16848
- +6 ;ACR*2.1*19.02 IM16848
- SET AFSLTT4=$SELECT(AFSLX="E":$PIECE(^AUTTVNDR(AFSLTT1A,0),U,1),1:$$NAME2^ACRFUTL1(AFSLTT1A))
- +7 ;ACR*2.1*19.02 IM16848
- SET AFSLTT4=AFSLTT4_$JUSTIFY("",35-$LENGTH(AFSLTT4))
- +8 ;ACR*2.1*19.02 IM16848
- SET AFSLTT4=$EXTRACT(AFSLTT4,1,35)
- +9 SET AFSLTT(AFSLTT2,AFSLCNT1,0)=AFSLTT(AFSLTT2,AFSLCNT1,0)_AFSLTT4
- +10 IF AFSLX["E"
- DO VADR^AFSLTT4
- +11 IF AFSLX'["E"
- DO EADR^AFSLTT4
- +12 SET AFSLTT(AFSLTT2,AFSLCNT1,2)=AFSLTT(AFSLTT2,AFSLCNT1,2)_$JUSTIFY("",67)_$SELECT(AFSLCBC<10:"0"_AFSLCBC,1:AFSLCBC)
- +13 SET AFSLCNT=AFSLCNT+1
- SET AFSLAMT=AFSLAMT+AFSLCBA
- SET AFSLCBC=0
- SET AFSLCBA=0
- +14 DO PRC^AFSLTT2
- KILL AFSLTT
- SET AFSLCNT1=AFSLCNT1+1
- +15 QUIT
- CHK ;checks for certification date,open/close,export date
- +1 IF $DATA(^AFSLAFP(AFSLFYN,1,AFSLSCH1,0))
- SET AFSLSCH3=^(0)
- +2 IF '$TEST
- QUIT
- +3 IF $DATA(^AFSLAFP(AFSLFYN,1,AFSLSCH1,2))
- SET AFSLSCH2=^(2)
- +4 IF '$TEST
- QUIT
- +5 IF '$DATA(^AFSLAFP("ME",AFSLFYN,$PIECE(^AFSLAFP(AFSLFYN,1,AFSLSCH1,0),U,1)))
- QUIT
- +6 IF $PIECE(AFSLSCH3,U,5)]""
- IF $PIECE(AFSLSCH2,U,1)']""
- IF $PIECE(AFSLSCH2,U,3)["C"
- IF $PIECE(AFSLSCH2,U,2)'>DT-7
- SET AFSLFLG=1
- SET AFSLFLG1=1
- SET AFSLSCH=$PIECE(AFSLSCH3,U,1)
- SET AFSLSCH1(AFSLSCH1)=AFSLSCH1
- +7 SET AFSLOO="0000000000"
- +8 QUIT
- TNUM ;
- +1 SET X=AFSLBN
- +2 SET DIE="^AFSLAFP("_AFSLFYN_",1,"
- +3 SET DA(1)=AFSLFYN
- +4 SET DA=AFSLSCH1
- +5 SET DR="10////"_AFSLSH11
- +6 DO ^DIE
- +7 QUIT
- PDT ;
- +1 ;The variable AFSLPDT should be in a fileman format by the time it
- +2 ; is set into these files here. It was set in AFSLRTT1, AFSLRTTX,
- +3 ; AFSLEXM1 & AFSLSAV2. No change made here. Should be Y2k compliant.
- +4 SET DIE="^AFSLAFP("_AFSLFYN_",1,"_AFSLSCH1_",1,"
- SET DA(2)=AFSLFYN
- +5 SET DA(1)=AFSLSCH1
- SET DA=AFSLEIN1
- SET DR="19////"_AFSLPDT
- +6 DO ^DIE
- +7 SET AFSLDNUM=$PIECE(^AFSLAFP(AFSLFYN,1,AFSLSCH1,1,AFSLEIN1,1),U,16)
- SET AFSLDFYN=$PIECE(^(1),U,15)
- SET AFSLPDNM=$PIECE(^(1),U,7)
- +8 SET DIE="^AFSLODOC("_AFSLDFYN_",1,"_AFSLDNUM_",1,"
- +9 SET DA(2)=AFSLDFYN
- +10 SET DA(1)=AFSLDNUM
- +11 SET DA=AFSLPDNM
- +12 SET DR="1////"_AFSLPDT
- +13 DO ^DIE
- +14 QUIT
