- IBDY214 ;ALB/JLS - EDIT FILE 357.6 IEN 94 - PATCH IBD*2.1*14 13-DEC-96
- ;;Version 2.1 ; AUTOMATED INFO COLLECTION SYS ;**14**; 3-APR-96
- ;
- ; resets PCE DIM PIECE, NARRATIVE (#12.03) from 1 to 7 for entry
- ; PX INPUT IMMUNIZATION (#94).
- ;
- ; PX IMMUNIZATION INPUT/SELECTION entries AVAILABLE? (Y/N) field set
- ; to YES.
- ;
- D SETNARR,PXIMM
- Q
- ;
- SETNARR ; Reset field 12.03 from 1 (original) to 7 (new) for ien #94
- N X,IBDIMM94
- S X(1)=">>> Updating the PCE DIM PIECE, NARRATIVE field for ien #94 in file 357.6."
- S X(2)=" " D BMES^XPDUTL(.X)
- S IBDIMM94=$G(^IBE(357.6,94,0)) I IBDIMM94]"" D
- .S $P(^IBE(357.6,94,12),"^",3)=7
- .W !,"Package File entry PX INPUT IMMUNIZATION has been updated."
- .Q
- I IBDIMM94="" W !,"Package File entry PX INPUT IMMUNIZATION not found, no updating done."
- Q
- PXIMM ; Check/Set AVAILABLE? (Y/N) field (#.09) to YES for PX IMMUNIZATION entries
- N X,IBDIMM86,IBDIMM94
- S X(1)=">>> Checking AVAILABLE? (Y/N) field (#.09) for PX IMMUNIZATION entries."
- S X(2)=" " D BMES^XPDUTL(.X)
- S IBDIMM86=$G(^IBE(357.6,86,0)) I IBDIMM86]"" D
- .S $P(^IBE(357.6,86,0),"^",9)=1
- .W !,"Package File entry PX SELECT IMMUNIZATIONS enabled."
- .Q
- I IBDIMM86="" W !,"Package File entry PX SELECT IMMUNIZATIONS not found, not enabled."
- ;
- S IBDIMM94=$G(^IBE(357.6,94,0)) I IBDIMM94]"" D
- .S $P(^IBE(357.6,94,0),"^",9)=1
- .W !,"Package File entry PX INPUT IMMUNIZATION enabled."
- .Q
- I IBDIMM94="" W !,"Package File entry PX INPUT IMMUNIZATION not found, not enabled."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDY214 1522 printed Mar 13, 2025@22:00:14 Page 2
- IBDY214 ;ALB/JLS - EDIT FILE 357.6 IEN 94 - PATCH IBD*2.1*14 13-DEC-96
- +1 ;;Version 2.1 ; AUTOMATED INFO COLLECTION SYS ;**14**; 3-APR-96
- +2 ;
- +3 ; resets PCE DIM PIECE, NARRATIVE (#12.03) from 1 to 7 for entry
- +4 ; PX INPUT IMMUNIZATION (#94).
- +5 ;
- +6 ; PX IMMUNIZATION INPUT/SELECTION entries AVAILABLE? (Y/N) field set
- +7 ; to YES.
- +8 ;
- +9 DO SETNARR
- DO PXIMM
- +10 QUIT
- +11 ;
- SETNARR ; Reset field 12.03 from 1 (original) to 7 (new) for ien #94
- +1 NEW X,IBDIMM94
- +2 SET X(1)=">>> Updating the PCE DIM PIECE, NARRATIVE field for ien #94 in file 357.6."
- +3 SET X(2)=" "
- DO BMES^XPDUTL(.X)
- +4 SET IBDIMM94=$GET(^IBE(357.6,94,0))
- IF IBDIMM94]""
- Begin DoDot:1
- +5 SET $PIECE(^IBE(357.6,94,12),"^",3)=7
- +6 WRITE !,"Package File entry PX INPUT IMMUNIZATION has been updated."
- +7 QUIT
- End DoDot:1
- +8 IF IBDIMM94=""
- WRITE !,"Package File entry PX INPUT IMMUNIZATION not found, no updating done."
- +9 QUIT
- PXIMM ; Check/Set AVAILABLE? (Y/N) field (#.09) to YES for PX IMMUNIZATION entries
- +1 NEW X,IBDIMM86,IBDIMM94
- +2 SET X(1)=">>> Checking AVAILABLE? (Y/N) field (#.09) for PX IMMUNIZATION entries."
- +3 SET X(2)=" "
- DO BMES^XPDUTL(.X)
- +4 SET IBDIMM86=$GET(^IBE(357.6,86,0))
- IF IBDIMM86]""
- Begin DoDot:1
- +5 SET $PIECE(^IBE(357.6,86,0),"^",9)=1
- +6 WRITE !,"Package File entry PX SELECT IMMUNIZATIONS enabled."
- +7 QUIT
- End DoDot:1
- +8 IF IBDIMM86=""
- WRITE !,"Package File entry PX SELECT IMMUNIZATIONS not found, not enabled."
- +9 ;
- +10 SET IBDIMM94=$GET(^IBE(357.6,94,0))
- IF IBDIMM94]""
- Begin DoDot:1
- +11 SET $PIECE(^IBE(357.6,94,0),"^",9)=1
- +12 WRITE !,"Package File entry PX INPUT IMMUNIZATION enabled."
- +13 QUIT
- End DoDot:1
- +14 IF IBDIMM94=""
- WRITE !,"Package File entry PX INPUT IMMUNIZATION not found, not enabled."
- +15 QUIT