- ENFAR9 ;WIRMFO/SAB-FAP DOCUMENT HISTORY OF EQUIPMENT ;7.21.97
- ;;7.0;ENGINEERING;**29,39**;AUG 17, 1993
- ;
- EN ; entry
- ; ask equipment
- D GETEQ^ENUTL G:Y'>0 EXIT
- S ENDA("EQ")=+Y
- ; ask detailed
- S DIR(0)="Y",DIR("A")="Include transaction details",DIR("B")="YES"
- D ^DIR K DIR G:$D(DIRUT) EXIT
- S ENDETAIL=+Y
- ; ask device
- S %ZIS="QM" D ^%ZIS G:POP EXIT
- I $D(IO("Q")) D G EN
- . S ZTRTN="QEN^ENFAR9",ZTDESC="FAP Document History of Equipment"
- . S ZTSAVE("ENDA(""EQ"")")="",ZTSAVE("ENDETAIL")=""
- . D ^%ZTLOAD,HOME^%ZIS K ZTSK
- QEN ; queued entry
- U IO
- ; find FAP documents
- K ENDOC
- S ENVALFA=0,ENVALFB=0
- S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
- D HD
- F ENFILE=6915.2:.1:6915.6 D
- . S ENDA("F?")=0
- . F S ENDA("F?")=$O(^ENG(ENFILE,"B",ENDA("EQ"),ENDA("F?"))) Q:'ENDA("F?") D
- . . S ENDT=$$GET1^DIQ(ENFILE,ENDA("F?"),1,"I")
- . . S:ENDT ENDOC(ENDT,ENFILE,ENDA("F?"))=""
- I '$D(ENDOC) W !!," NO FAP DOCUMENTS FOUND"
- I $D(ENDOC) D
- . ; load FA Type -> SGL table
- . K ENFATT S I=0 F S I=$O(^ENG(6914.3,I)) Q:'I S X=^(I,0) I $P(X,U)]"",$P(X,U,3)]"" S ENFATT($P(X,U,3))=$P(X,U)
- . I ENDETAIL D ; for calls to ENFARC2
- . . S ENTAG("HD")="HD^ENFAR9"
- . . S ENTAG("HDC")="HDC^ENFAR9"
- . . S ENTAG("FT")="FT^ENFAR9"
- . ; print data
- . S ENDT="" F S ENDT=$O(ENDOC(ENDT)) Q:ENDT="" D Q:END
- . . S ENFILE="" F S ENFILE=$O(ENDOC(ENDT,ENFILE)) Q:ENFILE="" D Q:END
- . . . S ENDA("F?")=$O(ENDOC(ENDT,ENFILE,0))
- . . . D @("DOC"_$P(ENFILE,".",2))
- . . . I 'ENDETAIL,$Y+6>IOSL D FT,HD Q:END
- . . . I ENDETAIL,$Y+11>IOSL D FT,HD Q:END
- . . . W !,ENTRC,?6,ENTRN,?16,$TR($$FMTE^XLFDT(ENDT,"2DF")," ",0),?26,ENSN
- . . . W:ENFAT]"" ?33,$G(ENFATT(ENFAT))
- . . . W:ENVAL]"" ?38,$J("$"_$FN(ENVAL,",",2),14)
- . . . W ?54,$E($P($$GET1^DIQ(ENFILE,ENDA("F?"),1.5),","),1,10)
- . . . W ?65,$J("$"_$FN(ENVALFA+ENVALFB,",",2),14)
- . . . I ENDETAIL W:ENFILE'[".6" ! D @("F"_$P(ENFILE,".",2)_"^ENFARC2") W !
- I 'END D FT
- D ^%ZISC
- I $E(IOST,1,2)="C-" W ! G EN
- EXIT I $D(ZTQUEUED) S ZTREQ="@"
- K END,ENDA,ENDETAIL,ENDOC,ENDT,ENDTR,ENFAT,ENFATT,ENFILE
- K ENPG,ENSN,ENTAG,ENTRC,ENTRN,ENVAL,ENVALFA,ENVALFB,I,X,Y
- Q
- HD ; header
- I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
- I $E(IOST,1,2)="C-"!ENPG W @IOF S $X=0
- S ENPG=ENPG+1
- W "FAP DOCUMENT HISTORY FOR EQUIPMENT",?49,ENDTR,?72,"page ",ENPG
- W !," ENTRY #: ",ENDA("EQ")
- W " CURRENT VALUE: $",$FN($$GET1^DIQ(6914,ENDA("EQ"),12),",",2)
- W !!,"TRANSACTION",?26,"STA",?33,"SGL",?38,"DOCUMENT VALUE",?54,"SENDER",?65,"ASSET VALUE"
- W !,"CODE*",?6,"NUMBER",?16,"DATE",?26,"NBR",?65,"AFTER DOCUMENT"
- W !,"-----",?6,"---------",?16,"--------",?26,"-----",?33,"----"
- W ?38,"--------------",?54,"----------",?65,"--------------"
- Q
- HDC ; header for continued transaction
- W !,?5,"Transaction: ",$E(ENTRC,1,2),"-",ENTRN," (continued)"
- Q
- FT ; footer
- W !!," * Betterment # follows FB and FC. T (Turn-In) or D (Final Disp.) follows FD."
- Q
- DOC2 ; FA document
- S ENTRC="FA 00"
- S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),24),1,5)
- S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),25)
- S ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),53)
- S ENVALFA=ENVAL,ENVALFB=0
- S ENDA("FA")=ENDA("F?")
- Q
- DOC3 ; FB document
- S ENTRC="FB "_$$GET1^DIQ(ENFILE,ENDA("F?"),23)
- S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),21),1,5)
- S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),22)
- S ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),36)
- S ENVALFB=ENVALFB+ENVAL
- Q
- DOC4 ; FC document
- S ENTRC="FC "_$$GET1^DIQ(ENFILE,ENDA("F?"),27)
- S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),25),1,5)
- S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),26)
- S ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),54)
- I ENTRC["00",ENVAL]"" S ENVALFA=ENVAL
- I ENTRC'["00",ENVAL]"" S ENVALFB=ENVALFB+(ENVAL-$$GET1^DIQ(ENFILE,ENDA("F?"),103))
- Q
- DOC5 ; FD document
- S ENTRC="FD "_$$GET1^DIQ(ENFILE,ENDA("F?"),100,"I")
- S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),27),1,5)
- S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),28)
- S ENVAL=""
- Q
- DOC6 ; FR document
- S ENTRC="FR"
- S ENTRN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- S ENSN=$E($$GET1^DIQ(ENFILE,ENDA("F?"),24),1,5)
- S ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),25)
- S ENVAL=""
- Q
- ;ENFAR9
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAR9 4367 printed Feb 18, 2025@23:20:05 Page 2
- ENFAR9 ;WIRMFO/SAB-FAP DOCUMENT HISTORY OF EQUIPMENT ;7.21.97
- +1 ;;7.0;ENGINEERING;**29,39**;AUG 17, 1993
- +2 ;
- EN ; entry
- +1 ; ask equipment
- +2 DO GETEQ^ENUTL
- if Y'>0
- GOTO EXIT
- +3 SET ENDA("EQ")=+Y
- +4 ; ask detailed
- +5 SET DIR(0)="Y"
- SET DIR("A")="Include transaction details"
- SET DIR("B")="YES"
- +6 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO EXIT
- +7 SET ENDETAIL=+Y
- +8 ; ask device
- +9 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO EXIT
- +10 IF $DATA(IO("Q"))
- Begin DoDot:1
- +11 SET ZTRTN="QEN^ENFAR9"
- SET ZTDESC="FAP Document History of Equipment"
- +12 SET ZTSAVE("ENDA(""EQ"")")=""
- SET ZTSAVE("ENDETAIL")=""
- +13 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- End DoDot:1
- GOTO EN
- QEN ; queued entry
- +1 USE IO
- +2 ; find FAP documents
- +3 KILL ENDOC
- +4 SET ENVALFA=0
- SET ENVALFB=0
- +5 SET (END,ENPG)=0
- DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET ENDTR=Y
- +6 DO HD
- +7 FOR ENFILE=6915.2:.1:6915.6
- Begin DoDot:1
- +8 SET ENDA("F?")=0
- +9 FOR
- SET ENDA("F?")=$ORDER(^ENG(ENFILE,"B",ENDA("EQ"),ENDA("F?")))
- if 'ENDA("F?")
- QUIT
- Begin DoDot:2
- +10 SET ENDT=$$GET1^DIQ(ENFILE,ENDA("F?"),1,"I")
- +11 if ENDT
- SET ENDOC(ENDT,ENFILE,ENDA("F?"))=""
- End DoDot:2
- End DoDot:1
- +12 IF '$DATA(ENDOC)
- WRITE !!," NO FAP DOCUMENTS FOUND"
- +13 IF $DATA(ENDOC)
- Begin DoDot:1
- +14 ; load FA Type -> SGL table
- +15 KILL ENFATT
- SET I=0
- FOR
- SET I=$ORDER(^ENG(6914.3,I))
- if 'I
- QUIT
- SET X=^(I,0)
- IF $PIECE(X,U)]""
- IF $PIECE(X,U,3)]""
- SET ENFATT($PIECE(X,U,3))=$PIECE(X,U)
- +16 ; for calls to ENFARC2
- IF ENDETAIL
- Begin DoDot:2
- +17 SET ENTAG("HD")="HD^ENFAR9"
- +18 SET ENTAG("HDC")="HDC^ENFAR9"
- +19 SET ENTAG("FT")="FT^ENFAR9"
- End DoDot:2
- +20 ; print data
- +21 SET ENDT=""
- FOR
- SET ENDT=$ORDER(ENDOC(ENDT))
- if ENDT=""
- QUIT
- Begin DoDot:2
- +22 SET ENFILE=""
- FOR
- SET ENFILE=$ORDER(ENDOC(ENDT,ENFILE))
- if ENFILE=""
- QUIT
- Begin DoDot:3
- +23 SET ENDA("F?")=$ORDER(ENDOC(ENDT,ENFILE,0))
- +24 DO @("DOC"_$PIECE(ENFILE,".",2))
- +25 IF 'ENDETAIL
- IF $Y+6>IOSL
- DO FT
- DO HD
- if END
- QUIT
- +26 IF ENDETAIL
- IF $Y+11>IOSL
- DO FT
- DO HD
- if END
- QUIT
- +27 WRITE !,ENTRC,?6,ENTRN,?16,$TRANSLATE($$FMTE^XLFDT(ENDT,"2DF")," ",0),?26,ENSN
- +28 if ENFAT]""
- WRITE ?33,$GET(ENFATT(ENFAT))
- +29 if ENVAL]""
- WRITE ?38,$JUSTIFY("$"_$FNUMBER(ENVAL,",",2),14)
- +30 WRITE ?54,$EXTRACT($PIECE($$GET1^DIQ(ENFILE,ENDA("F?"),1.5),","),1,10)
- +31 WRITE ?65,$JUSTIFY("$"_$FNUMBER(ENVALFA+ENVALFB,",",2),14)
- +32 IF ENDETAIL
- if ENFILE'[".6"
- WRITE !
- DO @("F"_$PIECE(ENFILE,".",2)_"^ENFARC2")
- WRITE !
- End DoDot:3
- if END
- QUIT
- End DoDot:2
- if END
- QUIT
- End DoDot:1
- +33 IF 'END
- DO FT
- +34 DO ^%ZISC
- +35 IF $EXTRACT(IOST,1,2)="C-"
- WRITE !
- GOTO EN
- EXIT IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 KILL END,ENDA,ENDETAIL,ENDOC,ENDT,ENDTR,ENFAT,ENFATT,ENFILE
- +2 KILL ENPG,ENSN,ENTAG,ENTRC,ENTRN,ENVAL,ENVALFA,ENVALFB,I,X,Y
- +3 QUIT
- HD ; header
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF ENPG
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET END=1
- QUIT
- +2 IF $EXTRACT(IOST,1,2)="C-"!ENPG
- WRITE @IOF
- SET $X=0
- +3 SET ENPG=ENPG+1
- +4 WRITE "FAP DOCUMENT HISTORY FOR EQUIPMENT",?49,ENDTR,?72,"page ",ENPG
- +5 WRITE !," ENTRY #: ",ENDA("EQ")
- +6 WRITE " CURRENT VALUE: $",$FNUMBER($$GET1^DIQ(6914,ENDA("EQ"),12),",",2)
- +7 WRITE !!,"TRANSACTION",?26,"STA",?33,"SGL",?38,"DOCUMENT VALUE",?54,"SENDER",?65,"ASSET VALUE"
- +8 WRITE !,"CODE*",?6,"NUMBER",?16,"DATE",?26,"NBR",?65,"AFTER DOCUMENT"
- +9 WRITE !,"-----",?6,"---------",?16,"--------",?26,"-----",?33,"----"
- +10 WRITE ?38,"--------------",?54,"----------",?65,"--------------"
- +11 QUIT
- HDC ; header for continued transaction
- +1 WRITE !,?5,"Transaction: ",$EXTRACT(ENTRC,1,2),"-",ENTRN," (continued)"
- +2 QUIT
- FT ; footer
- +1 WRITE !!," * Betterment # follows FB and FC. T (Turn-In) or D (Final Disp.) follows FD."
- +2 QUIT
- DOC2 ; FA document
- +1 SET ENTRC="FA 00"
- +2 SET ENTRN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- +3 SET ENSN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),24),1,5)
- +4 SET ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),25)
- +5 SET ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),53)
- +6 SET ENVALFA=ENVAL
- SET ENVALFB=0
- +7 SET ENDA("FA")=ENDA("F?")
- +8 QUIT
- DOC3 ; FB document
- +1 SET ENTRC="FB "_$$GET1^DIQ(ENFILE,ENDA("F?"),23)
- +2 SET ENTRN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- +3 SET ENSN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),21),1,5)
- +4 SET ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),22)
- +5 SET ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),36)
- +6 SET ENVALFB=ENVALFB+ENVAL
- +7 QUIT
- DOC4 ; FC document
- +1 SET ENTRC="FC "_$$GET1^DIQ(ENFILE,ENDA("F?"),27)
- +2 SET ENTRN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- +3 SET ENSN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),25),1,5)
- +4 SET ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),26)
- +5 SET ENVAL=$$GET1^DIQ(ENFILE,ENDA("F?"),54)
- +6 IF ENTRC["00"
- IF ENVAL]""
- SET ENVALFA=ENVAL
- +7 IF ENTRC'["00"
- IF ENVAL]""
- SET ENVALFB=ENVALFB+(ENVAL-$$GET1^DIQ(ENFILE,ENDA("F?"),103))
- +8 QUIT
- DOC5 ; FD document
- +1 SET ENTRC="FD "_$$GET1^DIQ(ENFILE,ENDA("F?"),100,"I")
- +2 SET ENTRN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- +3 SET ENSN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),27),1,5)
- +4 SET ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),28)
- +5 SET ENVAL=""
- +6 QUIT
- DOC6 ; FR document
- +1 SET ENTRC="FR"
- +2 SET ENTRN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),10),1,9)
- +3 SET ENSN=$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),24),1,5)
- +4 SET ENFAT=$$GET1^DIQ(ENFILE,ENDA("F?"),25)
- +5 SET ENVAL=""
- +6 QUIT
- +7 ;ENFAR9
